PC speaker, timer reprogramming / ISR, fix IN and OUT instructions

This commit is contained in:
Jeremy Penner 2023-09-28 22:07:10 -04:00
parent dd6cfe85cd
commit 47d14694c7
11 changed files with 134 additions and 24 deletions

10
asm.jrt
View file

@ -334,14 +334,14 @@ var ignoreimm
: AX? oparg-reg? oparg-val @ 0x00 = and ;
: >inout* ( base )
arg2 oparg-reg? oparg-val @ 0x03 ( DX ) = and arg1 if
oparg-reg? oparg-val @ 0x03 ( DX ) = and swap-args if
AL? if 8 + >t 2ret then
AX? if 9 + >t 2ret then
then
arg2 oparg-imm? arg1 if
AL? if >t oparg-val @ >t 2ret then
AX? if 1+ >t oparg-val @ >t 2ret then
swap-args oparg-imm? swap-args if
AL? if swap-args >t oparg-val @ >t 2ret then
AX? if swap-args 1+ >t oparg-val @ >t 2ret then
then ;
2 :op IN 0xe4 >inout* ;
2 :op IN arg2 0xe4 >inout* ;
2 :op OUT 0xe6 >inout* ;

Binary file not shown.

27
beep.jrt Executable file
View file

@ -0,0 +1,27 @@
import timer.jrt
:asm >spk ( div -- )
MOV AL 0xb6 #
OUT 0x43 # AL
POP AX
OUT 0x42 # AL
MOV AL AH
OUT 0x42 # AL
IN AL 0x61 #
OR AL 0x03 #
OUT 0x61 # AL
NEXT
:asm silence ( -- )
IN AL 0x61 #
AND AL 0xfc #
OUT 0x61 # AL
NEXT
: slide ( div count + -- )
>r begin over >spk 1 sleep-csec swap r@ + swap 1- dup not until
rdrop drop drop silence ;
: boop ( div count -- ) swap >spk sleep-csec silence ;
: noise ( count -- )
begin rand >spk 1 sleep-csec 1- dup not until drop silence ;

9
common.jrt Executable file
View file

@ -0,0 +1,9 @@
import text.jrt
import keys.jrt
import random.jrt
: !+ ( v p -- ) dup @ <rot + swap ! ;
: b!+ ( v p -- ) dup b@ <rot + swap b! ;
: b!| ( f p -- ) dup b@ <rot | swap b! ;
: b!^ ( f p -- ) dup b@ <rot ^ swap b! ;
: ~ 0xffff ^ ;

View file

@ -16,8 +16,8 @@ We start with MINIJORT.EXE, compiled with Borland Turbo C++ from MINIJORT.C
and MAIN.C. This is a stripped-down version of the Jorth engine that Neut
Tower[1] was built with, and the only part of this project that existed in
any form before August 14, 2023. (I started early on the jam because I
basically knew what I wanted to implement, and I knew that getting _anything_
playable by the end of September with the absurd plan I had in mind was
basically knew what I wanted to implement, and with the absurd plan I had in
mind, I knew that getting _anything_ playable by the end of September was
going to be a long shot.) MINIJORT.EXE is a simple Forth interpreter that
loads BOOT.JOR and then reads the rest of its input from stdin.

BIN
swine.com

Binary file not shown.

View file

@ -1,12 +1,10 @@
import text.jrt
import keys.jrt
import random.jrt
import timer.jrt
import beep.jrt
: !+ ( v p -- ) dup @ <rot + swap ! ;
: b!+ ( v p -- ) dup b@ <rot + swap b! ;
: b!| ( f p -- ) dup b@ <rot | swap b! ;
: b!^ ( f p -- ) dup b@ <rot ^ swap b! ;
: ~ 0xffff ^ ;
: meep 2000 5 -80 slide ;
: moop 1600 5 80 slide ;
: boom 40 noise ;
: click 2000 3 boop 4000 3 boop ;
0 const IN-PROGRESS
1 const CANCEL
@ -114,10 +112,13 @@ var neighbour-check
: reveal-unflagged-neighbours? ( p -- )
dup square-pos count-surrounding-flags over squarecount =
if square-pos ' reveal do-neighbour-squares else drop then ;
if click square-pos ' reveal do-neighbour-squares else drop then ;
: reveal-at square-at dup revealed?
if reveal-unflagged-neighbours? else reveal then autoreveal check-win ;
: flag-at square-at dup revealed? not if FFLAG swap b!^ else drop then ;
if reveal-unflagged-neighbours? else reveal click then
autoreveal check-win ;
: flag-noise ( p -- ) b@ FFLAG & if moop else meep then ;
: flag-at square-at dup revealed? not
if FFLAG swap dup flag-noise b!^ else drop then ;
( theming )
array countcolors white b, lblue b, lgreen b, red b, blue b,
@ -269,10 +270,11 @@ var current-menu
5 popupbox ( x ) 10 textxy! draw-spaced-text
wait-key drop ;
: fanfare meep moop meep moop meep moop meep ;
: display-result
game-state b@
dup WON = if green bg! lcyan fg! s" YOU WON" 26 result-message then
LOST = if red bg! yellow fg! s" YOU LOST" 25 result-message then ;
dup WON = if fanfare green bg! lcyan fg! s" YOU WON" 26 result-message then
LOST = if boom red bg! yellow fg! s" YOU LOST" 25 result-message then ;
2 :noname blue bg! lgray fg! 4 popupbox ; defmenu quitmenu
' leave s" Return to game" 0 defitem
@ -285,7 +287,7 @@ var current-menu
begin draw-game await-command confirm-quit in-progress? not until
draw-board display-result enter ;
: start init-board play ;
: start init-board boardw @ 2/ cursx b! boardh @ 2/ cursy b! play ;
( title menu )
array title-text t", SWINE MEEPER"
@ -316,7 +318,9 @@ array title-text t", SWINE MEEPER"
' theme-menu s" Themes" 2 defitem
' leave s" Quit" 3 defitem
: title textmode reseed! hidecursor title-menu textmode ;
: title install-timer textmode reseed! hidecursor
title-menu
textmode uninstall-timer ;
' title ' main redefine

68
timer.jrt Executable file
View file

@ -0,0 +1,68 @@
:asm intvect@ ( int -- seg off )
XOR BX BX
MOV ES BX
POP BX
SHL BX 1 #
SHL BX 1 #
PUSH @[ 2 @+ ES: BX]
PUSH @[ ES: BX]
NEXT
:asm intvect! ( seg off int -- )
XOR BX BX
MOV ES BX
POP BX
SHL BX 1 #
SHL BX 1 #
CLI
POP @[ ES: BX]
POP @[ 2 @+ ES: BX]
STI
NEXT
: irq 8 + ;
{ :timm :asmisr ( int -- ) ARRAY 4 ALLOT w>t CLI PUSH AX ;
:timm ISR-DONE MOV AL 0x20 # OUT 0x20 # AL POP AX STI IRET ;
:timm CHAIN-ISR ( isr -- )
POP AX
STI
JMP FAR CS: @+ ; }
:asm get-cseg
PUSH CS
NEXT
: isr>int ( isr -- int ) 2 cells + @ ;
: isr>code ( isr -- p ) 3 cells + ;
: uninstall-isr ( isr -- )
>r r@ cell + @ r@ @ <r isr>int intvect! ;
: install-isr ( isr -- )
>r r@ isr>int intvect@ r@ ! r@ cell + !
get-cseg r@ isr>code <r isr>int intvect! ;
var timer
0 irq :asmisr timer-isr
MOV AX CS: timer @+
INC AX
MOV CS: timer @+ AX
AND AX 0x03 #
JZ 0 @>
ISR-DONE
0 <:
timer-isr CHAIN-ISR
:asm set-timer-div ( div -- )
MOV AL 0x36 #
OUT 0x43 # AL
POP AX
OUT 0x40 # AL
MOV AL AH
OUT 0x40 # AL
NEXT
: sleep-csec ( cs -- )
timer @ + begin dup timer @ <= until drop ;
: install-timer 0xffff 2 >> set-timer-div timer-isr install-isr ;
: uninstall-timer 0xffff set-timer-div timer-isr uninstall-isr ;

Binary file not shown.

View file

@ -162,5 +162,7 @@ dbg" boot"
MOV BP 0x00 #
NEXT
} import common.jrt {
here s", zipstub.seg" s" zipoff.com" writeenv

Binary file not shown.