Wormie - Graphics Demo

\ ===================================================================
\      Program: Wormie.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, plotting 800 pixels
\ in patterns manipulated by a sine formula.
\
\ ===================================================================
\ 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 [wormie] [if]
  forget [wormie]
[then]

: [wormie] ;

\ ---[ Library Files ]-----------------------------------------------

\ ===[ SetMode ]===

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 ]===

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 ]===

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 ]===

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

\ =====================[ Demonstration Code ]========================

\ ---[ Constants ]---------------------------------------------------

 800 constant #dots
1100 constant slen1
1200 constant slen2
  49 constant samp1
  39 constant samp2
  50 constant sofs1
  50 constant sofs2
   3 constant dx1
   5 constant dy1
   4 constant xspd1
   2 constant yspd1
   4 constant dx2
   3 constant dy2
   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 ( -- )
  100 to %xst1
  800 to %xst2
  300 to %yst1
  700 to %yst2
  begin
    #dots 0 do
    \ calculate the previous pixel position
      %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

    \ calculate the new pixel position
      %yst1 yspd1 + i dy1 * + slen1 mod stab1[] + C@[EMAIL PROTECTED]
      %yst2 yspd2 + i dy2 * + slen2 mod stab2[] + C@[EMAIL PROTECTED]
 + 320 *
      %xst1 xspd1 + i dx1 * + slen1 mod stab1[] + C@[EMAIL PROTECTED]
 +
      %xst2 xspd2 + i dx2 * + slen2 mod stab2[] + C@[EMAIL PROTECTED]
 + 60 + to %onset

      0 VBuffer[] %offset + C!            \ erase previous pixel
      32 i 32 mod + VBuffer[] %onset + C! \ plot new pixel
    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

    WaitRetrace
    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
;

integer

: wormie
  $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 'wormie' for demo." cr ;

task