\ ===================================================================
\ Program: Wavy.4th
\ Author: Timothy Trussell
\ Date: 04/20/2008
\ Description: Graphics demo
\ Forth System: OS2FORTH by Rick van Norman, available on Taygeta
\ Assembler: Built-in FORTH assembler
\ ===================================================================
\
\ A short graphics demo in 320x200x256 Mode 13h,
\
\ ===================================================================
\ This is coded for the 32Forth system, the DOS DPMI version of
\ Rick van Norman's OS2FORTH package, avaialable in the Taygeta
\ Scientific FORTH Archives at www.taygeta.com
\ ===================================================================
exists [wavy] [if]
forget [wavy]
[then]
: [wavy] ;
\ ---[ Library Files ]-----------------------------------------------
\ ===[ SetMode ]===
\ Enter/exit different video modes
code SetMode ( mode -- )
ax ax xor \ ah=Function #0
bl al mov \ al=mode to set
int10 #) call
bx pop
end-code
NO-EXPAND
: InitGraph ( mode -- ) SetMode ;
: CloseGraph ( -- ) 3 SetMode ;
\ ===[ Retrace ]===
\ Waits for the start of a retrace cycle of the video card
\ Can be used as a consistent, time equivalent delay on all systems.
code WaitRetrace ( -- )
$03DA # dx mov
1 L:
dx al in
8 # al test
1 L# jnz
2 L:
dx al in
8 # al test
2 L# jz
end-code
NO-EXPAND
\ ===[ HeapAllot ]===
\ Allocates memory from the user heap above the dictionary
\ Memory is allocated from 64k below the current Stack Pointer,
\ and is allocated downwards. The SP is set at the end of
\ addressable memory in the 32Forth memory map.
value %EndHeap \ End of Heap pointer
value %HeapPtr \ Top of Heap pointer
SP@[EMAIL PROTECTED]
65536 - \ set end of heap to TOS-65536
\ change if you need more stack space
dup 16 mod - \ align to paragraph boundary
to %EndHeap
%EndHeap to %HeapPtr \ they are equal at initialization
: HeapAllot ( size "name" -- addr )
create \ =[Compile Time Functions]=
%HeapPtr over - \ calculate new TOS
dup 16 mod - \ align to lower paragraph boundary
dup , \ store address of new allocation
dup to %HeapPtr \ update to new TOS
swap 0 fill \ zero the memory block
does> \ =[Run Time Function]=
@[EMAIL PROTECTED]
\ load start address of memory block
;
value VSelector $0A000 SEG>DESC to VSelector
64000 HeapAllot VBuffer[]
\ ===[ BlitBuffer ]===
\ Blasts a double buffer to the video memory
code BlitBuffer
si push
di push
es push
VSelector # ax mov
ax es mov
di di xor
VBuffer[] # ax mov
ax si mov
16000 # cx mov
rep movs
es pop
di pop
si pop
end-code
no-expand
\ ===[ CPortOut ]===
\ Outputs a byte value to the specified port
code CPortOut ( c addr -- )
\ bx=addr on entry as TOS
bx dx mov \ dx=addr
ax pop \ al=c
$EE C, \ OUT DX,AL
bx pop \ get new TOS
end-code
NO-EXPAND
\ ===[ SetRGB ]===
\ Programs a single VGA palette color (per pass)
: SetRGB ( c# r g b -- )
swap \ c# r b g
rot \ c# b g r
3 pick $03C8 CPortOut \ c# b g r
$03C9 CPortOut \ c# b g
$03C9 CPortOut \ c# b
$03C9 CPortOut \ c#
drop \ --
;
\ =====================[ Demonstration Code ]========================
\ ---[ Constants ]---------------------------------------------------
75 constant #dots
5 constant fade
600 constant slen1
300 constant slen2
49 constant samp1
39 constant samp2
50 constant sofs1
50 constant sofs2
2 constant dx1
3 constant dy1
3 constant dx2
2 constant dy2
3 constant xspd1
2 constant yspd1
2 constant xspd2
3 constant yspd2
\ ---[ Arrays ]------------------------------------------------------
slen1 HeapAllot stab1[] \ byte arrays
slen2 HeapAllot stab2[]
\ ---[ Variables ]---------------------------------------------------
value %xst1
value %xst2
value %yst1
value %yst2
value %offset
value %onset
: Plotter ( -- )
50 to %xst1
130 to %xst2
0 to %yst1
70 to %yst2
begin
WaitRetrace
10 0 do
#dots 0 do
%yst1 i dy1 * + slen1 mod stab1[] + C@[EMAIL PROTECTED]
%yst2 i dy2 * + slen2 mod stab2[] + C@[EMAIL PROTECTED]
+ 320 *
%xst1 i dx1 * + slen1 mod stab1[] + C@[EMAIL PROTECTED]
+
%xst2 i dx2 * + slen2 mod stab2[] + C@[EMAIL PROTECTED]
+ 60 + to %offset
%yst1 yspd1 fade * j * + i dy1 * + slen1 mod stab1[] + C@[EMAIL PROTECTED]
%yst2 yspd2 fade * j * + i dy2 * + slen2 mod stab2[] + C@[EMAIL PROTECTED]
+
320 *
%xst1 xspd1 fade * j * + i dx1 * + slen1 mod stab1[] + C@[EMAIL PROTECTED]
+
%xst2 xspd2 fade * j * + i dx2 * + slen2 mod stab2[] + C@[EMAIL PROTECTED]
+
60 + to %onset
0 VBuffer[] %offset + C!
18 5 j * + VBuffer[] %onset + C!
loop
loop
%xst1 xspd1 + slen1 mod to %xst1
%yst1 yspd1 + slen1 mod to %yst1
%xst2 xspd2 + slen2 mod to %xst2
%yst2 yspd2 + slen2 mod to %yst2
BlitBuffer
key?
until
key drop
;
floating
: InitTables
slen1 0 do
i S>F 4.0 3.1415926 F* F* slen1 S>F F/
FSIN samp1 S>F F* F>S sofs1 +
i stab1[] + C!
loop
slen2 0 do
i S>F 4.0 3.1415926 F* F* slen2 S>F F/
FSIN samp2 S>F F* F>S sofs2 +
i stab2[] + C!
loop
63 0 do
i i 3 / i 2 / i 2 / SetRGB
loop
;
integer
: wavy
$13 InitGraph \ initialize 320x200x256 mode
VBuffer[] 64000 0 fill \ zero the double buffer
InitTables \ initialize the lookup tables
Plotter \ run the demo
CloseGraph \ return to text mode
;
: task cr cr ." Enter 'wavy' for demo." cr ;
task
|
