\ WINDEMO10.F March 24th, 1999 - 21:37 DECIMAL DEFER _16@ CREATE PC.RECEIVING.TRANSMITANCE.DATA.BUFFER TOTAL.CHANNEL @ ( 12 ) 16 ( 2 ) * ALLOT : TRANSMITANCE.DATA.BUFFER>TEMP.DATA.MULTI.TASKING ( ... ) TEMP.DATA.MULTI.TASKING.COUNTER @ MAX.TEMP.DATA.MULTI.TASKING.COUNTER < IF TOTAL.CHANNEL @ 0 DO PC.RECEIVING.TRANSMITANCE.DATA.BUFFER I CELLS + _16@ TEMP.DATA.MULTI.TASKING.COUNTER @ CELLS TEMP.DATA.MULTI.TASKING + ! 1 TEMP.DATA.MULTI.TASKING.COUNTER +! LOOP ELSE DROP CR ." TEMP.DATA.MULTI.TASKING.COUNTER REACHES MAXIMUN ( 1000 ) " THEN ; : TRANSMITANCE.DATA.BUFFER>TEMP.DATA.MULTI.TASKING ( ... ) ; VARIABLE DISPLAY.SIGNAL.LENGTH 127 ( 7F ) DISPLAY.SIGNAL.LENGTH ! DEFER _"DISPLAY.SIGNAL" only forth also definitions 1280 value screen-mwidth 1024 value screen-mheight \ 400 to screen-width \ 300 to screen-height 950 to screen-width 650 to screen-height \ --------------------------------------------------------------- \ Define the BIT-WINDOW global drawing functions \ --------------------------------------------------------------- Windc demo-dc 2 value bit-originx 2 value bit-originy 0 value VGA-X \ VGA x coordinate in pixels 0 value VGA-Y \ VGA y coordinate in pixels 0 value LINE-VALUE 0 value walking? 0 value line-count 0 value save-count 0 value do-printing? -1 value prev-x -1 value prev-y : moveto ( x y -- ) 0max screen-height 4 - min swap 0max screen-width 4 - min swap bit-originy + swap bit-originx + swap over prev-x = over prev-y = and IF 2drop ELSE 2dup to prev-y to prev-x 2dup PrinterMoveTo: ThePrinter MoveTo: demo-dc THEN ; : lineto ( x y -- ) 0max screen-height 4 - min swap 0max screen-width 4 - min swap bit-originy + swap bit-originx + swap over prev-x = over prev-y = and IF 2drop ELSE 2dup to prev-y to prev-x 2dup PrinterLineTo: ThePrinter LineTo: demo-dc then 1 +to line-count ; : line ( x1 y1 x2 y2 -- ) 2swap moveto lineto ; \ ' LINE IS _LINE : line-color ( color_object -- ) ?ColorCheck dup to line-value dup case black of white endof white of black endof yellow of blue endof dup endcase PrinterLineColor: ThePrinter LineColor: demo-dc ; : DOT.LINE ( X Y COLOR ... ) line-color 2DUP 1+ LINE ; \ --------------------------------------------------------------- \ Define the BIT-WINDOW window class \ --------------------------------------------------------------- :Class bit-window abs GetHandle: dc call FillRect ?win-error EraseRect: DemoRect On_Paint: super WHITE LineColor: dc \ white color 0 0 MoveTo: dc \ horiz StartSize: self drop width max 0 LineTo: dc \ line 0 0 MoveTo: dc \ vertical StartSize: Demo-Tool-Bar nip 0 swap LineTo: dc \ line StartSize: Demo-Tool-Bar swap 1+ swap MoveTo: dc \ vertical StartSize: Demo-Tool-Bar drop 1+ 0 LineTo: dc \ line BLACK LineColor: dc 0 StartSize: Demo-Tool-Bar nip dup>r MoveTo: dc StartSize: self drop width max r> LineTo: dc StartSize: Demo-Tool-Bar over 0 MoveTo: dc LineTo: dc ;M \ the l parameter has already been removed by WINDOW.F, and put \ into Height and Width :M On_Size: ( h m w -- ) \ handle resize message Width StartSize: Demo-V-Buttons >r - 2 + r> Height StartSize: Demo-LR-Buttons bitorigy 2 - 0max + swap 4 - >r dup>r - over - r> 4 > \ if there are buttons in the bar IF 2 - \ then leave two more pixels of room \ else we'll already have two pixels of room ELSE r>drop StartSize: Demo-V-Buttons drop 4 - 0max >r THEN r> swap StartSize: Demo-Tool-Bar nip 1+ >r 2swap r@ + 2swap r> - Move: button-fill-window bitorigx bitorigy StartSize: Demo-Tool-Bar nip + 1+ Width StartSize: Demo-V-Buttons drop - 2 - dup to screen-width Height 4 - StartSize: Demo-Tool-Bar nip - 1- dup to screen-height Move: vga-bit-window Width StartSize: Demo-V-Buttons drop - bitorigy 2 - 0max StartSize: Demo-Tool-Bar nip + 1+ StartSize: Demo-V-Buttons Move: Demo-V-Buttons Width StartSize: Demo-LR-Buttons drop - Height StartSize: Demo-LR-Buttons nip - bitorigy 2 - 0max - StartSize: Demo-LR-Buttons Move: Demo-LR-Buttons 0 0 StartSize: Demo-Tool-Bar Move: Demo-Tool-Bar ;M :M SetVButtonBar: { buttonbar -- } buttonbar Demo-V-Buttons <> IF Close: Demo-V-Buttons buttonbar to Demo-V-Buttons self Start: Demo-V-Buttons On_Size: self then ;M :M SetLRButtonBar: { buttonbar -- } buttonbar Demo-LR-Buttons <> IF Close: Demo-LR-Buttons buttonbar to Demo-LR-Buttons self Start: Demo-LR-Buttons On_Size: self then ;M \ Mouse support connections from the applications window to the bitmapped \ window that will actually receive the mouse clicks :M SetClickFunc: ( cfa -- ) SetClickFunc: vga-bit-window ;M :M SetUnClickFunc: ( cfa -- ) SetUnClickFunc: vga-bit-window ;M :M SetDblClickFunc: ( cfa -- ) SetDblClickFunc: vga-bit-window ;M :M SetTrackFunc: ( cfa -- ) SetTrackFunc: vga-bit-window ;M \ All SC_xxxx command types always have the high nibble set to 0xF :M WM_SYSCOMMAND ( hwnd msg wparam lparam -- res ) over 0xF000 and 0xF000 <> IF over LOWORD DoMenu: CurrentMenu 0 ELSE DefWindowProc: [ self ] THEN ;M ;Object : uninit-demo ( -- ) DestroyWindow: DEMOW ; unload-chain chain-add-before uninit-demo \ --------------------------------------------------------------- \ Demo about dialog, copied from the Forth About Dialog \ --------------------------------------------------------------- create about-demo-msg z," WinDemo, Public Domain, Updated March 1996\n" +z," Version 1.2\n\n" +z," Written by Tom Zimmer" -null, here 0 c, align about-demo-msg - constant about-demo-len :Object AboutWinDemo r + r> message-origin MessageText: msg-window Start: msg-window ELSE 2drop THEN ; : demo-message-off ( -- ) message-off StartPos: DEMOW StartPos: msg-window rot - 0max >r swap - 0max r> message-origin ; \ copy VGA-DC bitmap, f1=true=inverted : copy-demo-bitmap { flag \ hbm hdcMem -- } GetHandle: DEMOW call OpenClipboard 0= IF s" Can't Open Clipboard\n\n...press a key to continue" "demo-message key drop demo-message-off EXIT THEN flag SCREEN-HEIGHT SCREEN-WIDTH GetHandle: demo-dc call CreateCompatibleBitmap to hbm GetHandle: demo-dc call CreateCompatibleDC to hdcMem hbm hdcMem call SelectObject drop r> IF NOTSRCCOPY ELSE SRCCOPY THEN 0 0 \ y,x origin GetHandle: demo-dc \ from the screen SCREEN-HEIGHT \ source height SCREEN-WIDTH \ source width 0 0 hdcMem \ to new bitmap call BitBlt ?win-error \ invert the bitmap call EmptyClipboard ?win-error \ clear out the clipboard hbm CF_BITMAP call SetClipboardData ?win-error call CloseClipboard ?win-error hdcMem call DeleteDC ?win-error \ We don't delete the bitmap because it is now owned by the clipboard !! \ hbm call DeleteObject ?win-error ; : paste-demo-bitmap { flag \ hbm hdcMem -- } GetHandle: DEMOW call OpenClipboard 0= IF s" Can't Open Clipboard\n\n...press a key to continue" "demo-message 2000 ms demo-message-off EXIT then SCREEN-WIDTH SCREEN-HEIGHT CreateCompatibleBitMap: demo-dc to hbm GetHandle: demo-dc call CreateCompatibleDC to hdcMem CF_BITMAP call GetClipboardData dup to hbm ?win-error hbm hdcMem call SelectObject drop flag IF NOTSRCCOPY ELSE SRCCOPY THEN 0 0 \ y,x origin hdcMem \ from memory dc SCREEN-HEIGHT \ source height SCREEN-WIDTH \ source width 0 0 \ y,x dest GetHandle: demo-dc \ to screen call BitBlt ?win-error \ invert the bitmap call CloseClipboard ?win-error hdcMem call DeleteDC ?win-error \ hbm call DeleteObject ?win-error ; FileOpenDialog ViewBitmap "Open Bitmap File" "Bitmap Files (*.BMP)|*.BMP|*.DIB|All Files (*.*)|*.*|" FileSaveDialog SaveBitmap "Save Bitmap File" "Bitmap Files (*.BMP)|*.BMP|*.DIB|All Files (*.*)|*.*|" \ --------------------------------------------------------------- \ Open image file support \ --------------------------------------------------------------- : open-demo-bitmap { \ open$ hbm hdcMem -- } max-path LocalAlloc: open$ GetHandle: DEMOW Start: ViewBitmap dup c@ \ -- a1 n1 IF count open$ place LR_LOADFROMFILE LR_CREATEDIBSECTION or NULL NULL IMAGE_BITMAP open$ dup +NULL 1+ rel>abs NULL Call LoadImage to hbm GetHandle: demo-dc Call CreateCompatibleDC to hdcMem hbm hdcMem Call SelectObject drop SRCCOPY \ 0 0 \ y,x origin hdcMem \ from memory dc SCREEN-HEIGHT \ height of dest rect SCREEN-WIDTH \ width of dest rect 0 0 \ y,x dest GetHandle: demo-dc \ to screen Call BitBlt ?win-error \ hdcMem Call DeleteDC ?win-error ELSE DROP THEN ; \ --------------------------------------------------------------- \ Save File support \ --------------------------------------------------------------- 4 constant sizeof(RGBQUAD) 14 constant sizeof(BitmapFileHeader) 40 constant sizeof(BitmapInfoHeader) 0 constant biSize 4 constant biWidth 8 constant biHeight 12 constant biPlanes 14 constant biBitCount 16 constant biCompression 20 constant biSizeImage 24 constant biXPelsPerMeter 28 constant biYPelsPerMeter 32 constant biClrUsed 36 constant biClrImportant : show-BITMAPINFOHEADER { pbmih \ bmih$ -- } max-path localalloc: bmih$ s" BITMAPINFOHEADER" bmih$ place s" \nbiSize : " bmih$ +place pbmih biSize + @ 0 <# #s #> bmih$ +place s" \nbiWidth : " bmih$ +place pbmih biWidth + @ 0 <# #s #> bmih$ +place s" \nbiHeight : " bmih$ +place pbmih biHeight + @ 0 <# #s #> bmih$ +place s" \nbiPlanes : " bmih$ +place pbmih biPlanes + w@ 0 <# #s #> bmih$ +place s" \nbiBitCount : " bmih$ +place pbmih biBitcount + w@ 0 <# #s #> bmih$ +place s" \nbiCompression : " bmih$ +place pbmih biCompression + @ 0 <# #s #> bmih$ +place s" \nbiSizeImage : " bmih$ +place pbmih biSizeImage + @ 0 <# #s #> bmih$ +place s" \nbiXPelsPerMeter : " bmih$ +place pbmih biXPelsPerMeter + @ 0 <# #s #> bmih$ +place s" \nbiYPelsPerMeter : " bmih$ +place pbmih biYPelsPerMeter + @ 0 <# #s #> bmih$ +place s" \nbiClrUsed : " bmih$ +place pbmih biClrUsed + @ 0 <# #s #> bmih$ +place s" \nbiClrImportant :" bmih$ +place pbmih biClrImportant + @ 0 <# #s #> bmih$ +place bmih$ count "message key drop message-off ; : save-demo-bitmap { nBits \ pbmi lpBits hbm hdcMem hfile nrgbquad BitmapFileHeader save$ -- } 14 LocalAlloc: BitmapFileHeader max-path LocalAlloc: save$ s" Save Bitmap File: " save$ place nBits (.) save$ +place s" Bit" save$ +place save$ count SetTitle: SaveBitmap GetHandle: DEMOW Start: SaveBitmap dup c@ IF count save$ place sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + malloc to pbmi pbmi sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + erase \ (1) DON'T DELETE THIS LINE \ sizeof(BitmapInfoHeader) pbmi biSize + ! SCREEN-WIDTH pbmi biWidth + ! SCREEN-HEIGHT pbmi biHeight + ! 1 pbmi biPlanes + w! nBits pbmi biBitCount + w! nBits CASE 1 OF BI_RGB 2 to nrgbquad ENDOF 4 OF BI_RLE4 16 to nrgbquad ENDOF \ Could also be BI_RGB for 8 OF BI_RLE8 256 to nrgbquad ENDOF \ uncompressed format 16 OF BI_RGB 0 to nrgbquad ENDOF 24 OF BI_RGB 0 to nrgbquad ENDOF 32 OF BI_RGB 0 to nrgbquad ENDOF ENDCASE pbmi biCompression + ! \ 0 pbmi biSizeImage + ! NOT NEEDED (1) \ 0 pbmi biXPelsPerMeter + ! SINCE \ 0 pbmi biYPelsPerMeter + ! pbmi IS ERASED \ 0 pbmi biClrUsed + ! ABOVE \ 0 pbmi biClrImportant + ! SCREEN-HEIGHT SCREEN-WIDTH GetHandle: demo-dc Call CreateCompatibleBitmap to hbm GetHandle: demo-dc Call CreateCompatibleDC to hdcMem hbm hdcMem Call SelectObject drop SRCCOPY \ 0 0 \ y,x origin GetHandle: demo-dc \ from screen dc SCREEN-HEIGHT \ height of dest rect SCREEN-WIDTH \ width of dest rect 0 0 \ y,x dest hdcMem \ to memory dc Call BitBlt ?win-error \ DIB_RGB_COLORS pbmi rel>abs NULL SCREEN-HEIGHT 0 hbm hdcMem Call GetDIBits 0= abort" 1st GetDIBits" \ pbmi show-bitmapinfoheader pbmi biSizeImage + @ malloc rel>abs to lpBits lpBits abs>rel pbmi biSizeImage + @ erase DIB_RGB_COLORS pbmi rel>abs lpBits SCREEN-HEIGHT 0 hbm hdcMem Call GetDIBits 0= abort" 2nd GetDIBits" \ pbmi show-bitmapinfoheader save$ count GENERIC_READ GENERIC_WRITE or create-file abort" CreateFile" to hfile 0x4d42 BitmapFileHeader w! \ hdr.bfType sizeof(BitmapFileHeader) sizeof(BitmapInfoHeader) + nrgbquad sizeof(RGBQUAD) * + pbmi biSizeImage + @ + BitmapFileHeader 2 + ! \ hdr.bfSize 0 BitmapFileHeader 6 + w! \ hdr.bfReserved1 0 BitmapFileHeader 8 + w! \ hdr.bfReserved2 sizeof(BitmapFileHeader) sizeof(BitmapInfoHeader) + nrgbquad sizeof(RGBQUAD) * + BitmapFileHeader 10 + ! \ hdr.bfOffBits BitmapFileHeader sizeof(BitmapFileHeader) hfile write-file drop pbmi sizeof(BitmapInfoHeader) nrgbquad sizeof(RGBQUAD) * + hfile write-file drop lpBits abs>rel pbmi biSizeImage + @ hfile write-file drop hfile close-file drop hdcMem call DeleteDC ?win-error hbm call DeleteObject ?win-error lpBits abs>rel release pbmi release ELSE drop THEN ; ' save-demo-bitmap is save-bitmap only forth also definitions \ --------------------------------------------------------------- \ Actual application section for DEMO \ --------------------------------------------------------------- 0 value SEED1-SAVE 0 value SEED2-SAVE 0 value SEED3-SAVE 1 value dinc 0 value -hdots 0 value -vdots ColorObject TheNextColor : next-color ( -- ) BLACK line-color \ make sure that TheNextColor object \ is not selected into the DC 256 random 1+ \ before trying to create a new color 256 random 1+ 256 random 1+ rgb NewColor: TheNextColor TheNextColor line-color ; : erase-demo ( -- ) 0 0 screen-width screen-height WHITE PrinterFillArea: ThePrinter 0 0 screen-width screen-height BLACK FillArea: demo-dc seed1 to seed1-save \ save this seed set in case we seed2 to seed2-save \ want to print it seed3 to seed3-save 0 to line-count ; \ INCLUDE HH51W101 HEX CREATE FONT.TABLE ( 00 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 01 ) 07E C, 081 C, 0A5 C, 081 C, 0BD C, 099 C, 081 C, 07E C, ( 02 ) 07E C, 0FF C, 0DB C, 0FF C, 0C3 C, 0E7 C, 0FF C, 07E C, ( 03 ) 044 C, 0EE C, 0FE C, 0FE C, 07C C, 038 C, 010 C, 000 C, ( 04 ) 010 C, 038 C, 07C C, 0FE C, 07C C, 038 C, 010 C, 000 C, ( 05 ) 018 C, 03C C, 0DB C, 0FF C, 0DB C, 018 C, 03C C, 000 C, ( 06 ) 018 C, 03C C, 07E C, 0FF C, 07E C, 018 C, 03C C, 000 C, ( 07 ) 018 C, 03C C, 07E C, 0FF C, 07E C, 018 C, 03C C, 000 C, ( 08 ) 018 C, 03C C, 07E C, 0FF C, 07E C, 018 C, 03C C, 000 C, ( 09 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 0A ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 0B ) 00F C, 007 C, 007 C, 07D C, 0CC C, 0CC C, 0CC C, 078 C, ( 0C ) 078 C, 0CC C, 0CC C, 0CC C, 078 C, 030 C, 0FC C, 030 C, ( 0D ) 078 C, 0CC C, 0CC C, 0CC C, 078 C, 030 C, 0FC C, 030 C, ( 0E ) 03F C, 063 C, 07F C, 063 C, 063 C, 067 C, 0E6 C, 0C0 C, ( 0F ) 0DB C, 0DB C, 03C C, 0E7 C, 0E7 C, 03C C, 0DB C, 0DB C, ( 10 ) 0C0 C, 0F0 C, 0F8 C, 0FE C, 0F8 C, 0F0 C, 0C0 C, 000 C, ( 11 ) 006 C, 01E C, 03E C, 0FE C, 03E C, 01E C, 006 C, 000 C, ( 12 ) 030 C, 078 C, 0FC C, 030 C, 030 C, 0FC C, 078 C, 030 C, ( 13 ) 06C C, 06C C, 06C C, 06C C, 06C C, 000 C, 06C C, 000 C, ( 14 ) 07F C, 0DB C, 0DB C, 0DB C, 07B C, 01B C, 01B C, 000 C, ( 15 ) 03C C, 060 C, 03C C, 066 C, 066 C, 03C C, 006 C, 03C C, ( 16 ) 000 C, 000 C, 000 C, 000 C, 0FE C, 0FE C, 0FE C, 000 C, ( 17 ) 018 C, 03C C, 07E C, 018 C, 07E C, 03C C, 018 C, 07E C, ( 18 ) 030 C, 078 C, 0FC C, 030 C, 030 C, 030 C, 030 C, 000 C, ( 19 ) 030 C, 030 C, 030 C, 030 C, 0FC C, 078 C, 030 C, 000 C, ( 1A ) 030 C, 030 C, 030 C, 030 C, 0FC C, 078 C, 030 C, 000 C, ( 1B ) 000 C, 020 C, 060 C, 0FE C, 060 C, 020 C, 000 C, 000 C, ( 1C ) 000 C, 000 C, 0C0 C, 0C0 C, 0FE C, 000 C, 000 C, 000 C, ( 1D ) 000 C, 024 C, 042 C, 0FF C, 042 C, 024 C, 000 C, 000 C, ( 1E ) 000 C, 010 C, 038 C, 07C C, 0FE C, 0FE C, 000 C, 000 C, ( 1F ) 000 C, 0FE C, 0FE C, 07C C, 038 C, 010 C, 000 C, 000 C, ( 20 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 21 ) 018 C, 018 C, 018 C, 018 C, 018 C, 000 C, 018 C, 000 C, ( 22 ) 0CC C, 0CC C, 0CC C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 23 ) 036 C, 06C C, 0FE C, 06C C, 0FE C, 06C C, 0D8 C, 000 C, ( 24 ) 018 C, 07E C, 0C0 C, 07C C, 006 C, 0FC C, 030 C, 000 C, ( 25 ) 0C2 C, 0C6 C, 00C C, 018 C, 030 C, 066 C, 0C6 C, 000 C, ( 26 ) 038 C, 06C C, 038 C, 070 C, 0DE C, 0CC C, 076 C, 000 C, ( 27 ) 030 C, 030 C, 060 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 28 ) 00C C, 018 C, 030 C, 030 C, 030 C, 018 C, 00C C, 000 C, ( 29 ) 030 C, 018 C, 00C C, 00C C, 00C C, 018 C, 030 C, 000 C, ( 2A ) 000 C, 06C C, 038 C, 0FE C, 038 C, 06C C, 000 C, 000 C, ( 2B ) 000 C, 018 C, 018 C, 07E C, 018 C, 018 C, 000 C, 000 C, ( 2C ) 000 C, 000 C, 000 C, 000 C, 000 C, 018 C, 018 C, 030 C, ( 2D ) 000 C, 000 C, 000 C, 07E C, 000 C, 000 C, 000 C, 000 C, ( 2E ) 000 C, 000 C, 000 C, 000 C, 000 C, 018 C, 018 C, 000 C, ( 2F ) 002 C, 006 C, 00C C, 018 C, 030 C, 060 C, 0C0 C, 000 C, ( 30 ) 07C C, 0CE C, 0DE C, 0F6 C, 0E6 C, 0C6 C, 07C C, 000 C, ( 31 ) 018 C, 038 C, 018 C, 018 C, 018 C, 018 C, 07E C, 000 C, ( 32 ) 07C C, 0C6 C, 006 C, 01C C, 070 C, 0C6 C, 0FE C, 000 C, ( 33 ) 07C C, 0C6 C, 006 C, 01C C, 006 C, 0C6 C, 07C C, 000 C, ( 34 ) 01C C, 03C C, 06C C, 0CC C, 0FE C, 00C C, 00C C, 000 C, ( 35 ) 0FE C, 0C0 C, 0FC C, 006 C, 006 C, 0C6 C, 07C C, 000 C, ( 36 ) 03C C, 060 C, 0C0 C, 0FC C, 0C6 C, 0C6 C, 07C C, 000 C, ( 37 ) 0FE C, 0C6 C, 00C C, 018 C, 030 C, 030 C, 030 C, 000 C, ( 38 ) 07C C, 0C6 C, 0C6 C, 07C C, 0C6 C, 0C6 C, 07C C, 000 C, ( 39 ) 07C C, 0C6 C, 0C6 C, 07E C, 006 C, 00C C, 078 C, 000 C, ( 3A ) 000 C, 018 C, 018 C, 000 C, 000 C, 018 C, 018 C, 000 C, ( 3B ) 000 C, 018 C, 018 C, 000 C, 000 C, 018 C, 018 C, 030 C, ( 3C ) 00C C, 018 C, 030 C, 060 C, 030 C, 018 C, 00C C, 000 C, ( 3D ) 000 C, 000 C, 07E C, 000 C, 000 C, 07E C, 000 C, 000 C, ( 3E ) 030 C, 018 C, 00C C, 006 C, 00C C, 018 C, 030 C, 000 C, ( 3F ) 03C C, 066 C, 006 C, 00C C, 018 C, 000 C, 018 C, 000 C, ( 40 ) 07C C, 0C6 C, 0DE C, 0DE C, 0DE C, 0C0 C, 07C C, 000 C, ( 41 ) 038 C, 06C C, 0C6 C, 0C6 C, 0FE C, 0C6 C, 0C6 C, 000 C, ( 42 ) 0FC C, 06E C, 066 C, 07C C, 066 C, 06E C, 0FC C, 000 C, ( 43 ) 03E C, 062 C, 0C0 C, 0C0 C, 0C0 C, 062 C, 03E C, 000 C, ( 44 ) 0F8 C, 06E C, 066 C, 066 C, 066 C, 06E C, 0F8 C, 000 C, ( 45 ) 0FE C, 062 C, 060 C, 078 C, 060 C, 062 C, 0FE C, 000 C, ( 46 ) 0FE C, 062 C, 060 C, 078 C, 060 C, 060 C, 0F0 C, 000 C, ( 47 ) 03E C, 062 C, 0C0 C, 0C0 C, 0CE C, 066 C, 03E C, 000 C, ( 48 ) 0C6 C, 0C6 C, 0C6 C, 0FE C, 0C6 C, 0C6 C, 0C6 C, 000 C, ( 49 ) 03C C, 018 C, 018 C, 018 C, 018 C, 018 C, 03C C, 000 C, ( 4A ) 01E C, 00C C, 00C C, 00C C, 00C C, 0CC C, 078 C, 000 C, ( 4B ) 0E6 C, 066 C, 06C C, 078 C, 078 C, 06C C, 0E6 C, 000 C, ( 4C ) 0F0 C, 060 C, 060 C, 060 C, 060 C, 066 C, 0FE C, 000 C, ( 4D ) 0C6 C, 0EE C, 0FE C, 0D6 C, 0C6 C, 0C6 C, 0C6 C, 000 C, ( 4E ) 0C6 C, 0E6 C, 0F6 C, 0FE C, 0DE C, 0CE C, 0C6 C, 000 C, ( 4F ) 07C C, 0C6 C, 0C6 C, 0C6 C, 0C6 C, 0C6 C, 07C C, 000 C, ( 50 ) 0FC C, 066 C, 066 C, 07C C, 060 C, 060 C, 0E0 C, 000 C, ( 51 ) 07C C, 0C6 C, 0C6 C, 0D6 C, 0DE C, 07C C, 006 C, 000 C, ( 52 ) 0FC C, 066 C, 066 C, 07C C, 078 C, 06C C, 0E6 C, 000 C, ( 53 ) 07C C, 0C6 C, 0E0 C, 038 C, 00E C, 0C6 C, 07C C, 000 C, ( 54 ) 07E C, 05A C, 018 C, 018 C, 018 C, 018 C, 03C C, 000 C, ( 55 ) 066 C, 066 C, 066 C, 066 C, 066 C, 066 C, 03C C, 000 C, ( 56 ) 066 C, 066 C, 066 C, 066 C, 066 C, 03C C, 018 C, 000 C, ( 57 ) 0C6 C, 0C6 C, 0C6 C, 0D6 C, 0FE C, 0FE C, 0C6 C, 000 C, ( 58 ) 0C6 C, 06C C, 038 C, 038 C, 06C C, 0C6 C, 0C6 C, 000 C, ( 59 ) 066 C, 066 C, 066 C, 03C C, 018 C, 018 C, 03C C, 000 C, ( 5A ) 0FE C, 0CC C, 018 C, 030 C, 060 C, 0C6 C, 0FE C, 000 C, ( 5B ) 03C C, 030 C, 030 C, 030 C, 030 C, 030 C, 03C C, 000 C, ( 5C ) 080 C, 0C0 C, 060 C, 030 C, 018 C, 00C C, 006 C, 000 C, ( 5D ) 03C C, 00C C, 00C C, 00C C, 00C C, 00C C, 03C C, 000 C, ( 5E ) 018 C, 03C C, 066 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 5F ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 0FF C, ( 60 ) 018 C, 018 C, 00C C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 61 ) 000 C, 000 C, 038 C, 00C C, 07C C, 0CC C, 076 C, 000 C, ( 62 ) 060 C, 060 C, 060 C, 07C C, 066 C, 066 C, 0DC C, 000 C, ( 63 ) 000 C, 000 C, 07C C, 0C4 C, 0C0 C, 0C4 C, 07C C, 000 C, ( 64 ) 00C C, 00C C, 00C C, 07C C, 0CC C, 0CC C, 076 C, 000 C, ( 65 ) 000 C, 000 C, 078 C, 0CC C, 0FC C, 0C0 C, 07C C, 000 C, ( 66 ) 038 C, 06C C, 060 C, 0F8 C, 060 C, 060 C, 0E0 C, 000 C, ( 67 ) 000 C, 000 C, 076 C, 0CC C, 0CC C, 07C C, 00C C, 07C C, ( 68 ) 0E0 C, 060 C, 060 C, 07C C, 066 C, 066 C, 066 C, 000 C, ( 69 ) 030 C, 000 C, 070 C, 030 C, 030 C, 030 C, 038 C, 000 C, ( 6A ) 00C C, 000 C, 01C C, 00C C, 00C C, 0CC C, 0CC C, 078 C, ( 6B ) 0E0 C, 060 C, 066 C, 06C C, 078 C, 06C C, 066 C, 000 C, ( 6C ) 070 C, 030 C, 030 C, 030 C, 030 C, 030 C, 038 C, 000 C, ( 6D ) 000 C, 000 C, 0CC C, 0FE C, 0D6 C, 0C6 C, 0C6 C, 000 C, ( 6E ) 000 C, 000 C, 0DC C, 066 C, 066 C, 066 C, 066 C, 000 C, ( 6F ) 000 C, 000 C, 03C C, 066 C, 066 C, 066 C, 03C C, 000 C, ( 70 ) 000 C, 000 C, 0DC C, 066 C, 066 C, 07C C, 060 C, 0E0 C, ( 71 ) 000 C, 000 C, 076 C, 0CC C, 0CC C, 07C C, 00C C, 00E C, ( 72 ) 000 C, 000 C, 0DC C, 076 C, 060 C, 060 C, 060 C, 000 C, ( 73 ) 000 C, 000 C, 078 C, 0C0 C, 078 C, 00C C, 078 C, 000 C, ( 74 ) 010 C, 030 C, 078 C, 030 C, 030 C, 034 C, 018 C, 000 C, ( 75 ) 000 C, 000 C, 0CC C, 0CC C, 0CC C, 0CC C, 076 C, 000 C, ( 76 ) 000 C, 000 C, 066 C, 066 C, 066 C, 03C C, 018 C, 000 C, ( 77 ) 000 C, 000 C, 0C6 C, 0C6 C, 0D6 C, 0FE C, 06C C, 000 C, ( 78 ) 000 C, 000 C, 0CC C, 078 C, 030 C, 078 C, 0CC C, 000 C, ( 79 ) 000 C, 000 C, 0CC C, 0CC C, 0CC C, 07C C, 00C C, 07C C, ( 7A ) 000 C, 000 C, 0FC C, 018 C, 030 C, 060 C, 0FC C, 000 C, ( 7B ) 00E C, 018 C, 018 C, 070 C, 018 C, 018 C, 00E C, 000 C, ( 7C ) 030 C, 030 C, 030 C, 000 C, 030 C, 030 C, 030 C, 000 C, ( 7D ) 070 C, 018 C, 018 C, 00E C, 018 C, 018 C, 070 C, 000 C, ( 7E ) 000 C, 076 C, 0DC C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 7F ) 010 C, 038 C, 06C C, 0C6 C, 0C6 C, 0C6 C, 0FE C, 000 C, ( 80 ) 031 C, 02C C, 094 C, 007 C, 0F4 C, 006 C, 070 C, 000 C, ( 81 ) 016 C, 000 C, 053 C, 004 C, 0F4 C, 006 C, 070 C, 000 C, ( 82 ) 0F4 C, 006 C, 070 C, 000 C, 054 C, 0FF C, 000 C, 0F0 C, ( 83 ) 043 C, 0EB C, 000 C, 0F0 C, 0EB C, 0EA C, 000 C, 0F0 C, ( 84 ) 05F C, 002 C, 015 C, 006 C, 018 C, 017 C, 012 C, 0E1 C, ( 85 ) 057 C, 000 C, 053 C, 004 C, 06F C, 000 C, 053 C, 004 C, ( 86 ) 087 C, 000 C, 053 C, 004 C, 09F C, 000 C, 053 C, 004 C, ( 87 ) 0B7 C, 000 C, 053 C, 004 C, 0F4 C, 006 C, 070 C, 000 C, ( 88 ) 020 C, 001 C, 0DF C, 005 C, 04D C, 0F8 C, 000 C, 0F0 C, ( 89 ) 041 C, 0F8 C, 000 C, 0F0 C, 0BA C, 016 C, 012 C, 0E1 C, ( 8A ) 039 C, 0E7 C, 000 C, 0F0 C, 095 C, 017 C, 012 C, 0E1 C, ( 8B ) 02E C, 0E8 C, 000 C, 0F0 C, 0FD C, 001 C, 015 C, 006 C, ( 8C ) 000 C, 0E0 C, 000 C, 0F0 C, 085 C, 017 C, 012 C, 0E1 C, ( 8D ) 06E C, 0FE C, 000 C, 0F0 C, 046 C, 002 C, 094 C, 007 C, ( 8E ) 053 C, 0FF C, 000 C, 0F0 C, 0A4 C, 0F0 C, 000 C, 0F0 C, ( 8F ) 022 C, 005 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( 90 ) 094 C, 010 C, 016 C, 001 C, 07B C, 002 C, 015 C, 006 C, ( 91 ) 0B1 C, 002 C, 015 C, 005 C, 056 C, 002 C, 094 C, 007 C, ( 92 ) 0B1 C, 02A C, 094 C, 007 C, 0D3 C, 017 C, 012 C, 0E1 C, ( 93 ) 01C C, 018 C, 012 C, 0E1 C, 0BC C, 010 C, 016 C, 001 C, ( 94 ) 07A C, 003 C, 015 C, 006 C, 062 C, 007 C, 070 C, 000 C, ( 95 ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 96 ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 97 ) 03F C, 001 C, 015 C, 005 C, 085 C, 002 C, 0AC C, 0E3 C, ( 98 ) 0EA C, 0D0 C, 010 C, 016 C, 001 C, 0EA C, 000 C, 0F0 C, ( 99 ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 9A ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 9B ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 9C ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 9D ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 9E ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( 9F ) 0DA C, 010 C, 016 C, 001 C, 0DA C, 010 C, 016 C, 001 C, ( A0 ) 059 C, 0EC C, 000 C, 0F0 C, 03D C, 0E1 C, 000 C, 0F0 C, ( A1 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( A2 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( A3 ) 001 C, 0E4 C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( A4 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( A5 ) 097 C, 0EA C, 000 C, 0F0 C, 0DB C, 011 C, 001 C, 0C0 C, ( A6 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( A7 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( A8 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( A9 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( AA ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( AB ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( AC ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( AD ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( AE ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( AF ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( B0 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( B1 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( B2 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( B3 ) 000 C, 000 C, 000 C, 000 C, 0B0 C, 002 C, 0BE C, 002 C, ( B4 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( B5 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( B6 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( B7 ) 097 C, 0EA C, 000 C, 0F0 C, 097 C, 0EA C, 000 C, 0F0 C, ( B8 ) 052 C, 000 C, 053 C, 004 C, 0D2 C, 0EE C, 000 C, 0F0 C, ( B9 ) 0CF C, 000 C, 053 C, 004 C, 0E7 C, 000 C, 053 C, 004 C, ( BA ) 0FF C, 000 C, 053 C, 004 C, 0DB C, 0EE C, 000 C, 0F0 C, ( BB ) 017 C, 001 C, 053 C, 004 C, 0B7 C, 08E C, 000 C, 0F0 C, ( BC ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( BD ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( BE ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( BF ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C0 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C1 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C2 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C3 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C4 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C5 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C6 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C7 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C8 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( C9 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( CA ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( CB ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( CC ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( CD ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( CE ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( CF ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D0 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D1 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D2 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D3 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D4 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D5 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D6 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D7 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D8 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( D9 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( DA ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( DB ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( DC ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( DD ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( DE ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( DF ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E0 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E1 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E2 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E3 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E4 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E5 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E6 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E7 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E8 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( E9 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( EA ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( EB ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( EC ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( ED ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( EE ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( EF ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( F0 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( F1 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( F2 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( F3 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( F4 ) 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, 000 C, ( F5 ) 0D6 C, 000 C, 001 C, 091 C, 060 C, 0E8 C, 000 C, 0F0 C, ( F6 ) 0D6 C, 000 C, 001 C, 091 C, 060 C, 0E8 C, 000 C, 0F0 C, ( F7 ) 086 C, 002 C, 0D6 C, 000 C, 0D6 C, 000 C, 000 C, 091 C, ( F8 ) 060 C, 0E8 C, 000 C, 0F0 C, 002 C, 002 C, 030 C, 000 C, ( F9 ) 032 C, 0E9 C, 000 C, 0F0 C, 002 C, 002 C, 000 C, 000 C, ( FA ) 010 C, 000 C, 03E C, 09A C, 03A C, 097 C, 000 C, 000 C, ( FB ) 0FF C, 000 C, 001 C, 000 C, 000 C, 0A0 C, 020 C, 02B C, ( FC ) 000 C, 000 C, 040 C, 000 C, 000 C, 07E C, 04A C, 073 C, ( FD ) 000 C, 07C C, 080 C, 000 C, 001 C, 000 C, 059 C, 097 C, ( FE ) 01C C, 0F8 C, 004 C, 083 C, 000 C, 07C C, 040 C, 0EF C, ( FF ) 00B C, 0F8 C, 029 C, 0F7 C, 000 C, 0F0 C, 002 C, 070 C, : dot line-color over 1+ over 1+ line ; VARIABLE (X)1 VARIABLE (Y)1 VARIABLE (C)1 VARIABLE (COLOR)1 variable CHAR.MAGNIFICATION 1 CHAR.MAGNIFICATION ! : GC! ( ASCII.CODE X Y COLOR ... ) (COLOR)1 ! (Y)1 ! (X)1 ! (C)1 ! 8 0 DO (C)1 C@ 8 * FONT.TABLE + I + C@ 0 7 DO 2 /MOD SWAP IF (X)1 @ I 2 * + (Y)1 @ J 2 * + (COLOR)1 @ DOT THEN -1 +LOOP DROP LOOP ; : GC! ( ASCII.CODE X Y COLOR ... ) (COLOR)1 ! (Y)1 ! (X)1 ! (C)1 ! 8 0 DO (C)1 C@ 8 * FONT.TABLE + I + C@ 0 7 DO 2 /MOD SWAP IF (X)1 @ I CHAR.MAGNIFICATION @ * + (Y)1 @ J CHAR.MAGNIFICATION @ * + (COLOR)1 @ DOT THEN -1 +LOOP DROP LOOP ; VARIABLE SCALE 1 SCALE ! VARIABLE I' VARIABLE J' VARIABLE (X) VARIABLE (Y) \ VARIABLE X.MAX 140 1 - X.MAX ! \ 320-1 \ VARIABLE Y.MAX 0C8 1 - Y.MAX ! \ 200-1 VARIABLE X.MAX screen-width X.MAX ! \ 320-1 VARIABLE Y.MAX screen-height Y.MAX ! \ 200-1 : DOT' >R Y.MAX @ SWAP - X.MAX @ ROT MIN -ROT R> DOT ; \ : FOR >R [COMPILE] BEGIN ; IMMEDIATE \ : NEXT R> 1- ?DUP 0= [COMPILE] UNTIL ; IMMEDIATE \ : LL 10 FOR NEXT ; \ : BIG.CHAR ( CHAR X Y ... ) (Y) ! (X) ! \ 8 * FONT.TABLE + 7 \ FOR DUP R@ + R@ J' ! \ 7 \ FOR DUP R@ Mb=1? R@ I' ! \ IF SCALE @ 0 \ DO SCALE @ 0 \ DO (X) @ 7 I' @ - + I + 8 I' @ - SCALE @ * + \ (Y) @ 7 J' @ - + J + 8 J' @ - SCALE @ * + 3 DOT' \ LOOP \ LOOP \ THEN \ NEXT DROP \ NEXT DROP ; \ \ : T 20 20 BIG.CHAR ; \ 38 T CREATE N>2^N.TABLE \ N= 0 ~ F 1 , 2 , 4 , 8 , 10 , 20 , 40 , 80 , 100 , 200 , 400 , 800 , 1000 , 2000 , 4000 , 8000 , 10000 , 20000 , 40000 , 80000 , 100000 , 200000 , 400000 , 800000 , 1000000 , 2000000 , 4000000 , 8000000 , 10000000 , 20000000 , 40000000 , 80000000 , CREATE N>2^N.TABLE/ \ N= 0 ~ F FFFFFFFE , FFFFFFFD , FFFFFFFB , FFFFFFF7 , FFFFFFEF , FFFFFFDF , FFFFFFBF , FFFFFF7F , FFFFFEFF , FFFFFDFF , FFFFFBFF , FFFFF7FF , FFFFEFFF , FFFFDFFF , FFFFBFFF , FFFF7FFF , FFFEFFFF , FFFDFFFF , FFFBFFFF , FFF7FFFF , FFEFFFFF , FFDFFFFF , FFBFFFFF , FF7FFFFF , FEFFFFFF , FDFFFFFF , FBFFFFFF , F7FFFFFF , EFFFFFFF , DFFFFFFF , BFFFFFFF , 7FFFFFFF , \ DECIMAL : N>2^N ( N ... 2^N ) 4 * N>2^N.TABLE + @ ; : N>2^N/ ( N ... 2^N ) 4 * N>2^N.TABLE/ + @ ; : Mb=1? ( ADDR BIT.n ... F ) N>2^N SWAP C@ AND 0<> ; : Mb=0? ( ADDR BIT.n ... F ) Mb=1? NOT ; LTRED VALUE COLOR : BIG.CHAR ( CHAR X Y ... ) (Y) ! (X) ! 8 * FONT.TABLE + 0 7 DO DUP I + I J' ! 0 7 DO DUP 7 I - Mb=1? I I' ! IF SCALE @ 1 + 0 DO SCALE @ 1 + 0 DO (X) @ I' @ + I + I' @ SCALE @ * + (Y) @ J' @ + J + J' @ SCALE @ * + COLOR DOT LOOP LOOP THEN -1 +LOOP DROP -1 +LOOP DROP ; : T 20 20 BIG.CHAR ; \ 38 T : HH LTBLUE TO COLOR 4 scale ! 0A 0 DO 30 I + I SCALE @ 2 + * 8 * 10 BIG.CHAR LOOP ; \ HH : HH 4 scale ! 0A 0 DO I 2 MOD IF LTRED TO COLOR ELSE LTGREEN TO COLOR THEN 30 I + I SCALE @ 2 + * 8 * 10 BIG.CHAR LOOP ; \ HH : VV LTGREEN TO COLOR 3 scale ! 0A 1 DO 30 I + 30 I SCALE @ 2 + * 8 * BIG.CHAR LOOP ; \ VV VARIABLE Y.OFFSET 16 Y.OFFSET ! : VVV 1 SCALE ! 31 70 140 Y.OFFSET @ + BIG.CHAR \ 2 32 70 120 Y.OFFSET @ + BIG.CHAR \ 3 33 70 100 Y.OFFSET @ + BIG.CHAR \ 4 34 70 0E0 Y.OFFSET @ + BIG.CHAR \ 5 35 70 0C0 Y.OFFSET @ + BIG.CHAR \ 6 36 70 0A0 Y.OFFSET @ + BIG.CHAR \ 7 37 70 80 Y.OFFSET @ + BIG.CHAR \ 8 38 70 60 Y.OFFSET @ + BIG.CHAR \ 9 \ 39 70 40 Y.OFFSET @ + BIG.CHAR \ X0 \ 30 70 20 Y.OFFSET @ + BIG.CHAR \ X1 \ 31 70 0 Y.OFFSET @ + BIG.CHAR \ X1 \ 31 50 0 Y.OFFSET @ + BIG.CHAR \ 1X \ 31 50 20 Y.OFFSET @ + BIG.CHAR \ 1X ; \ windc thedc \ the Device Context \ : dot1 ( x y color ... ) setpixel: thedc ; VARIABLE (COLOR) VARIABLE (height) VARIABLE (width) VARIABLE (X) VARIABLE (Y) : VERTICAL-BAR ( X Y width height color ... ) (COLOR) ! (height) ! (width) ! (Y) ! (X) ! (X) @ (width) @ + (X) @ DO I (Y) @ I (Y) @ (height) @ + (COLOR) @ LINE LOOP ; : X0" 0 ( 3C ) ( 60 ) ; : Y0" 14 ( 20 ) ; \ 0 VALUE X0 \ 0 VALUE Y0 windc thedc \ the Device Context : dot1 ( x y color ... ) setpixel: thedc ; : BIG.DOT ( X Y COLOR ... ) >R OVER 1+ OVER 1+ R@ DOT OVER 1+ OVER R@ DOT OVER 1+ OVER 1- R@ DOT OVER OVER 1+ R@ DOT OVER OVER R@ DOT OVER OVER 1- R@ DOT OVER 1- OVER 1+ R@ DOT OVER 1- OVER R@ DOT OVER 1- OVER 1- R> DOT 2DROP Refresh: DEMOW \ REAL-TIME UPDATE DOT WINPAUSE 1 MS ; : BIG.DOT ( X Y COLOR ... ) >R OVER 1+ OVER 1+ R@ DOT OVER 1+ OVER R@ DOT OVER 1+ OVER 1- R@ DOT OVER OVER 1+ R@ DOT OVER OVER R@ DOT OVER OVER 1- R@ DOT OVER 1- OVER 1+ R@ DOT OVER 1- OVER R@ DOT OVER 1- OVER 1- R> DOT 2DROP \ Refresh: DEMOW \ REAL-TIME UPDATE DOT \ WINPAUSE 1 MS ; : SMALL.DOT ( X Y COLOR ... ) DOT ; : MARK.X.Y.SCALE' \ condc puthandle : thedc LTred line-color \ : thedc X0" Y0" moveto \ : thedc SCREEN-WIDTH Y0" lineto \ : thedc SCREEN-WIDTH SCREEN-HEIGHT lineto \ : thedc X0" SCREEN-HEIGHT lineto \ : thedc X0" Y0" lineto \ : thedc SCREEN-WIDTH 1+ X0" do 5 0 do j SCREEN-HEIGHT i - ltred SMALL.DOT j i Y0" + ltred SMALL.DOT loop 100 +loop SCREEN-HEIGHT 1+ Y0" do 5 0 do X0" i + j ltred SMALL.DOT SCREEN-WIDTH i - j ltred SMALL.DOT loop 100 +loop SCREEN-WIDTH 1+ X0" do SCREEN-HEIGHT 1+ Y0" do j i ltred SMALL.DOT 50 +loop 50 +loop ; DEFER _draw_1line defer _WINDEMO.VV' : erase-demo ( -- ) 0 0 screen-width screen-height WHITE PrinterFillArea: ThePrinter 0 0 screen-width screen-height LTYELLOW FillArea: demo-dc \ COMMENT: \ 15 29 78 90 _draw_1line 2DROP 2DROP \ 65 79 123 234 _draw_1line 2DROP 2DROP 0 0 100 600 LINE ." TEXT " \ ??? GRAPHIC TEXT 12 0 DO 200 0 \ DO I J + 50 i 3 / + I J + 200 LINE 30 \ DO I J + 50 i 3 / + swap I J + 200 swap LINE 30 DO I J + 50 swap I J + 200 i 3 / - swap LINE 25 +LOOP LOOP CR ." TP1 " .S \ MAP 100 0 do i i 2/ ltgreen dot loop CR ." TP2 " .S 46 30 do i i 30 - 9 * 2 * i 30 - 9 * ltred gc! loop \ 0 ~ 9 ..>! 34 7 11 BIG.CHAR CR ." TP3 " .S VV HH VVV 30 0 10 200 LTRED FillArea: demo-dc MARK.X.Y.SCALE' \ 800 MS 0 0 screen-width screen-height ( BLACK ) LTYELLOW FillArea: demo-dc seed1 to seed1-save \ save this seed set in case we seed2 to seed2-save \ want to print it seed3 to seed3-save 0 to line-count ; : erase-demo.DARK ( -- ) 0 0 screen-width screen-height WHITE PrinterFillArea: ThePrinter 0 0 screen-width screen-height LTGRAY ( LTYELLOW ) FillArea: demo-dc 0 0 100 100 LINE ." TEXT " \ ??? GRAPHIC TEXT MARK.X.Y.SCALE' seed1 to seed1-save \ save this seed set in case we seed2 to seed2-save \ want to print it seed3 to seed3-save 0 to line-count ; DEFER _PSC DEFER _T2.WIN VARIABLE Y0".OFFSET.WIN VARIABLE X0".OFFSET.WIN VARIABLE Y.SCALING.FACTOR.WIN VARIABLE X.SCALING.FACTOR.WIN DEFER _NUMBER>STRING : PLOT.X.Y.AXIS.VALUE.WIN ( X0" Y0" X.SCALING.FACTOR Y.SCALING.FACTOR ... ) Y.SCALING.FACTOR.WIN ! X.SCALING.FACTOR.WIN ! Y0".OFFSET.WIN ! X0".OFFSET.WIN ! 0 5 DO 5 I - Y.SCALING.FACTOR.WIN @ * _NUMBER>STRING 0 DO DUP I + C@ ( CHAR ) X0".OFFSET.WIN @ I 9 * + ( X ) Y0".OFFSET.WIN @ J 64 * + ( Y ) RED GC! LOOP DROP -1 +LOOP 0 8 DO I X.SCALING.FACTOR.WIN @ * _NUMBER>STRING 0 \ 1 ( 0 ) DO DUP I + C@ ( CHAR ) Y0".OFFSET.WIN @ ( I 9 * + ) ( Y ) 200 + I 9 * X0".OFFSET.WIN @ J 64 * + + ( X ) ( 10 + ) J 0 > IF 10 - THEN SWAP RED GC! LOOP DROP -1 +LOOP ; : PLOT.X.Y.AXIS.VALUE.WIN''' ( X0" Y0" X.SCALING.FACTOR Y.SCALING.FACTOR ... ) 2DROP 2DROP ; : erase-demo.1 ( -- ) 0 0 screen-width screen-height WHITE PrinterFillArea: ThePrinter 0 0 screen-width screen-height ( LTYELLOW ) WHITE FillArea: demo-dc COMMENT: \ 15 29 78 90 _draw_1line 2DROP 2DROP \ 65 79 123 234 _draw_1line 2DROP 2DROP 30 30 64 ( 100 ) 64 ( 100 ) LINE ." TEXT " \ ??? GRAPHIC TEXT 12 0 DO 200 0 DO I J + 50 i 3 / + I J + 200 LINE 30 \ DO I J + 50 i 3 / + swap I J + 200 swap LINE 30 \ DO I J + 50 swap I J + 200 i 3 / - swap LINE 25 +LOOP LOOP \ MAP 100 0 do i i 2/ ltgreen dot loop 40 30 do i i 30 - 9 * 2 * ( X ) i 30 - 9 * ( Y ) ltred gc! loop \ 0 ~ 9 ..>! 34 7 11 BIG.CHAR VV HH VVV 30 0 10 200 LTRED FillArea: demo-dc COMMENT; \ 46 30 do i i 30 - 9 * 2 * i 30 - 9 * ltred gc! loop 0 ( 1E ) ( 30 ) 10 64 ( 100 ) 64 ( 100 ) PLOT.X.Y.AXIS.VALUE.WIN ( MARK.X.Y.SCALE' ) LTBLUE LINE-COLOR _PSC _T2.WIN \ 0 0 100 100 LINE \ _WINDEMO.VV' \ 800 MS 0 0 screen-width screen-height ( BLACK ) LTYELLOW FillArea: demo-dc seed1 to seed1-save \ save this seed set in case we seed2 to seed2-save \ want to print it seed3 to seed3-save 0 to line-count ; DEFER _PC.RECEIVING.TRANSMITANCE.DATA CREATE FORMER.Y2 12 ALLOT FORMER.Y2 12 ERASE : SHOW.TRANSMITANCE ( -- ) _PC.RECEIVING.TRANSMITANCE.DATA \ VERTICAL BAR TYPE 0 0 screen-width screen-height WHITE PrinterFillArea: ThePrinter 0 0 screen-width screen-height ( LTYELLOW ) BLACK FillArea: demo-dc 12 0 DO 30 0 DO J 2 MOD IF LTRED ELSE LTGREEN THEN LINE-COLOR \ TO COLOR J 30 * I + ( X1 ) 255 ( Y1 ) OVER ( X2 ) J PC.RECEIVING.TRANSMITANCE.DATA.BUFFER + C@ DUP J FORMER.Y2 + C@ + SWAP J FORMER.Y2 + C! 255 SWAP - ( Y2 ) LINE LOOP LOOP seed1 to seed1-save \ save this seed set in case we seed2 to seed2-save \ want to print it seed3 to seed3-save 0 to line-count ; DECIMAL VARIABLE TIME.COUNT : TIME.COUNT.MAX 2048 ; CREATE 12.CH.DATA.AREA 16 4 * TIME.COUNT.MAX * ALLOT : ERASE.12.CH.DATA.AREA 12.CH.DATA.AREA 16 4 * TIME.COUNT.MAX * ERASE ; VARIABLE LAST.'KEY' DEFER _DATA>HEX.FILE 0 value fhd DEFER _·sÀÉ DEFER _¼gÀÉ DEFER _ÃöÀÉ : SHOW.TRANSMITANCE.TY.WIN ( -- ) \ 0 0 screen-width screen-height WHITE PrinterFillArea: ThePrinter \ 0 0 screen-width screen-height ( LTYELLOW ) BLACK FillArea: demo-dc s" 12CH.hex" R/W _·sÀÉ to fhd BEGIN _PC.RECEIVING.TRANSMITANCE.DATA TRANSMITANCE.DATA.BUFFER>TEMP.DATA.MULTI.TASKING TIME.COUNT @ TIME.COUNT.MAX >= IF CR ." TIME.COUNT FULL ( 2048 ) " ELSE PC.RECEIVING.TRANSMITANCE.DATA.BUFFER 12.CH.DATA.AREA TIME.COUNT @ 16 * + 16 CMOVE 1 TIME.COUNT +! THEN LAST.'KEY' @ 'W' <> \ -1 OR IF TIME.COUNT @ 0 ?DO 12 0 DO J ( X ) X0" + I J 16 * 4 * + 12.CH.DATA.AREA + C@ ( Y ) Y0" + LTRED BIG.DOT LOOP LOOP THEN 12 0 DO TIME.COUNT @ ( X ) X0" + I PC.RECEIVING.TRANSMITANCE.DATA.BUFFER + C@ DUP _DATA>HEX.FILE ( Y ) Y0" + I 2 MOD 0= IF LTGREEN ELSE LTRED THEN BIG.DOT Refresh: DEMOW \ REAL-TIME UPDATE DOT WINPAUSE 1 MS LOOP seed1 to seed1-save \ save this seed set in case we seed2 to seed2-save \ want to print it seed3 to seed3-save 0 to line-count KEY? UNTIL fhd _ÃöÀÉ ; : SHOW.TRANSMITANCE.TEXT.WIN''''''''''''' ( -- ) ( BEGIN ) _PC.RECEIVING.TRANSMITANCE.DATA 0 0 screen-width screen-height WHITE PrinterFillArea: ThePrinter 0 0 screen-width screen-height ( LTYELLOW ) BLACK FillArea: demo-dc 12 0 DO TIME.COUNT @ ( X ) I PC.RECEIVING.TRANSMITANCE.DATA.BUFFER + C@ ( Y ) LTRED BIG.DOT LOOP 1 TIME.COUNT +! seed1 to seed1-save \ save this seed set in case we seed2 to seed2-save \ want to print it seed3 to seed3-save 0 to line-count \ KEY? \ UNTIL ; : run-demo ( -- ) FALSE TO walking? next-color screen-height 1- to -vdots screen-width 1- to -hdots BEGIN -hdots random -vdots random -hdots random -vdots random -vdots 0 DO I + swap i - 2swap I - swap i + 2swap 2over 2over line 15 random 2 < IF next-color THEN I 31 and 0= IF Refresh: DEMOW WINPAUSE THEN LOOP 2drop 2drop key? do-printing? IF line-count save-count >= OR THEN UNTIL do-printing? 0= IF line-count to save-count THEN ; \ --------------------------------------------------------------- \ Actual application section for LINEWALK \ --------------------------------------------------------------- 0 value x1 0 value y1 0 value x2 0 value y2 : bounce_xy1 ( x2 y2 x1 y1 -- x2 y2 x1 y1 ) swap dup -hdots >= IF -1 TO x1 0 TO x2 next-color THEN dup 1 < IF 1 TO x1 0 TO x2 next-color THEN swap dup -vdots >= IF -1 TO y1 0 TO y2 next-color THEN dup 1 < IF 1 TO y1 0 TO y2 next-color THEN ; : bounce_xy2 ( x1 y1 x2 y2 -- x1 y1 x2 y2 ) swap dup -hdots >= IF -1 TO x2 0 TO x1 next-color THEN dup 1 < IF 1 TO x2 0 TO x1 next-color THEN swap dup -vdots >= IF -1 TO y2 0 TO y1 next-color THEN dup 1 < IF 1 TO y2 0 TO y1 next-color THEN ; 200 value line_max 400 value lines_max 0 value line_limit : limit_xy ( x2 y2 x1 y1 -- x2 y2 x1 y1 ) 2swap over >r 2swap over r> - dup abs line_limit > IF dup 0< IF 1 TO x1 -1 TO x2 ELSE 1 TO x2 -1 TO x1 THEN y1 0= y2 0= or IF 2 RANDOM 2 RANDOM - TO y1 then next-color THEN drop 2swap dup>r 2swap dup r> - dup abs line_limit > IF dup 0< IF 1 TO y1 -1 TO y2 ELSE 1 TO y2 -1 TO y1 THEN x1 0= x2 0= or IF 2 RANDOM 2 RANDOM - TO x1 then next-color THEN drop ; 0 value cnt-down 3 value cnt-down-max : draw-a-line ( x y x y -- ) cnt-down 0= IF line cnt-down-max TO cnt-down ELSE -1 +to cnt-down 2drop 2drop THEN ; : draw_1line ( x y x y -- x y x y ) line_max RANDOM 10 max TO line_limit 2 RANDOM 2 RANDOM - TO x1 2 RANDOM 2 RANDOM - TO y1 2 RANDOM 2 RANDOM - TO x2 2 RANDOM 2 RANDOM - TO y2 lines_max RANDOM 1+ 0 DO 4dup draw-a-line limit_xy swap x1 + swap y1 + bounce_xy1 2swap swap x2 + swap y2 + bounce_xy2 2swap i 1+ RANDOM 15 and 0= IF next-color THEN key? ?leave LOOP next-color ; ' draw_1line IS _draw_1line : line-walk ( -- ) TRUE TO walking? next-color screen-height 1- to -vdots screen-width 1- to -hdots -hdots 2/ -vdots 2/ 2dup BEGIN 10 0 DO draw_1line Refresh: DEMOW WINPAUSE LOOP 500 RANDOM TO line_max 5000 RANDOM TO lines_max 3 RANDOM TO cnt-down-max key? do-printing? IF line-count save-count >= OR THEN UNTIL 2drop do-printing? 0= IF line-count to save-count THEN ; : line-walk ( -- ) TRUE TO walking? next-color screen-height 1- to -vdots screen-width 1- to -hdots -hdots 2/ -vdots 2/ 2dup BEGIN 10 0 DO draw_1line Refresh: DEMOW WINPAUSE LOOP 500 RANDOM TO line_max 5000 RANDOM TO lines_max 3 RANDOM TO cnt-down-max key? do-printing? IF line-count save-count >= OR THEN UNTIL 2drop do-printing? 0= IF line-count to save-count THEN ; \ --------------------------------------------------------------- \ Printing support \ --------------------------------------------------------------- : print-demo ( -- ) TRUE to do-printing? seed1-save to seed1 \ print same as displayed seed2-save to seed2 seed3-save to seed3 200 TO line_max 400 TO lines_max 0 TO line_limit 0 TO cnt-down 3 TO cnt-down-max single-page start-scaled IF erase-demo S" Printing DEMO..." "demo-message walking? IF line-walk ELSE run-demo THEN print-scaled demo-message-off THEN FALSE to do-printing? ; : print-demo-bmp { nBits \ pbmi lpBits hbm hdcMem -- } Open: ThePrinter GetHandle: ThePrinter 0= ?EXIT Start: ThePrinter sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + malloc to pbmi pbmi sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + erase \ (1) DON'T DELETE THIS LINE \ sizeof(BitmapInfoHeader) pbmi biSize + ! SCREEN-WIDTH pbmi biWidth + ! SCREEN-HEIGHT pbmi biHeight + ! 1 pbmi biPlanes + w! nBits pbmi biBitCount + w! BI_RGB pbmi biCompression + ! \ 0 pbmi biSizeImage + ! NOT NEEDED (1) \ 0 pbmi biXPelsPerMeter + ! SINCE \ 0 pbmi biYPelsPerMeter + ! pbmi IS ERASED \ 0 pbmi biClrUsed + ! ABOVE \ 0 pbmi biClrImportant + ! SCREEN-HEIGHT SCREEN-WIDTH GetHandle: demo-dc Call CreateCompatibleBitmap to hbm GetHandle: demo-dc Call CreateCompatibleDC to hdcMem hbm hdcMem Call SelectObject drop SRCCOPY \ 0 0 \ y,x origin GetHandle: demo-dc \ from screen dc SCREEN-HEIGHT \ height of dest rect SCREEN-WIDTH \ width of dest rect 0 0 \ y,x dest hdcMem \ to memory dc Call BitBlt ?win-error \ DIB_RGB_COLORS pbmi rel>abs NULL SCREEN-HEIGHT 0 hbm hdcMem Call GetDIBits 0= abort" 1st GetDIBits" \ pbmi show-bitmapinfoheader pbmi biSizeImage + @ malloc rel>abs to lpBits lpBits abs>rel pbmi biSizeImage + @ erase DIB_RGB_COLORS pbmi rel>abs lpBits SCREEN-HEIGHT 0 hbm hdcMem Call GetDIBits 0= abort" 2nd GetDIBits" \ pbmi show-bitmapinfoheader SRCCOPY DIB_RGB_COLORS pbmi rel>abs lpBits SCREEN-HEIGHT SCREEN-WIDTH 0 0 Height: ThePrinter Width: ThePrinter 0 0 GetHandle: ThePrinter Call StretchDIBits GDI_ERROR = ABORT" StretchDIBits" End: ThePrinter Close: ThePrinter hdcMem call DeleteDC ?win-error hbm call DeleteObject ?win-error lpBits abs>rel release pbmi release ; \ --------------------------------------------------------------- \ Top Level program starts here \ --------------------------------------------------------------- DEFER _ADuC.SCOPE DEFER _ADuC.SCOPE' variable exit.windemo? DEFER _SHOW.TRANSMITTANCE.DATA.TEXT.TYPE DEFER _WINDEMO.VV DEFER _WINDEMO.VI DEFER _WINDEMO.IV DEFER _WINDEMO.II DEFER _WINDEMO.-VV DEFER _WINDEMO.-VI DEFER _WINDEMO.-IV DEFER _WINDEMO.-II DEFER _T2 DEFER _INI DEFER _DEMO5 DEFER _115.2K DEFER _COM1 DEFER _COM2 DEFER _COM3 DEFER _COM4 DEFER _COM5 DEFER _COM6 DEFER _COM7 DEFER _PARP DEFER _OLED DEFER _PAR>OLED.LIFE.TIME.TESTER DEFER _OLED DECIMAL : WINDEMO.n ( -- ) ( 1C200 ) ( 115200 _COM5 ) _INI TIME.COUNT OFF \ ERASE.12.CH.DATA.AREA \ : WINDEMO ( -- ) ( 1C200 ) 115200 _COM1 _INI TIME.COUNT OFF ERASE.12.CH.DATA.AREA Start: DEMOW StartPos: DEMOW 50 + swap 50 + swap message-origin blue line-color RANDOM-INIT \ initialize random number generator erase-demo begin Refresh: DEMOW key DUP LAST.'KEY' ! \ handle keyboard interpretation case 'O' +k_control of open-demo-bitmap endof '1' of 1 save-bitmap endof '2' of 4 save-bitmap endof '3' of 8 save-bitmap endof '4' of 16 save-bitmap endof '5' of 24 save-bitmap endof '6' of 32 save-bitmap endof 'S' +k_control of 16 save-bitmap endof 'S' of erase-demo.DARK _ADuC.SCOPE endof \ FROM ADuC7020 's' of erase-demo.DARK _ADuC.SCOPE' endof \ FROM ADuC7020 'T' of erase-demo.DARK DISPLAY.SIGNAL.LENGTH @ ( 100 ) 0 DO I I 6 / GREEN DOT LOOP _"DISPLAY.SIGNAL" endof \ FROM 8051 'Z' ( 'ESC' ) of exit.windemo? on EXIT endof 'V' +k_control of paste-demo-bitmap endof 'P' +k_control of print-demo endof 'Q' +k_control of 16 print-demo-bmp endof 'R' OF MULTI.TASKING ENDOF k_F1 of help-on-help endof k_F1 +k_control of about-demo endof k_cr of run-demo endof k_cr +k_control of line-walk 2DROP endof k_esc of erase-demo endof 'H' of erase-demo endof '!' OF _WINDEMO.VV' ENDOF \ 1 '@' OF _WINDEMO.VI ENDOF \ 2 '#' OF _WINDEMO.IV ENDOF \ 3 '$' OF _WINDEMO.II ENDOF \ 4 '%' OF _WINDEMO.-VV ENDOF \ 5 '^' OF _WINDEMO.-VI ENDOF \ 6 '&' OF _WINDEMO.-IV ENDOF \ 7 '*' OF _WINDEMO.-II ENDOF \ 8 'A' OF EXIT ENDOF 'M' OF _PARP ( F ) _DEMO5 ( M ) erase-demo.1 ( V ) SHOW.TRANSMITANCE.TY.WIN ( W ) Refresh: DEMOW \ REAL-TIME UPDATE DOT WINPAUSE \ 1 MS ENDOF 'O' OF _OLED ENDOF 'V' of erase-demo.1 endof 'U' OF 200 0 DO 200 I - I LTGREEN BIG.DOT Refresh: DEMOW \ REAL-TIME UPDATE DOT WINPAUSE 1 MS LOOP ENDOF 'W' OF SHOW.TRANSMITANCE.TY.WIN Refresh: DEMOW \ REAL-TIME UPDATE DOT WINPAUSE \ 1 MS ENDOF \ WAVEFORM '~' OF LAST.'KEY' @ '~' <> \ -1 OR IF TIME.COUNT @ 0 ?DO 12 0 DO J ( X ) I J 16 * 4 * + 12.CH.DATA.AREA + C@ ( Y ) LTRED BIG.DOT LOOP LOOP ELSE SHOW.TRANSMITANCE.TY.WIN Refresh: DEMOW WINPAUSE THEN ENDOF 'D' OF SHOW.TRANSMITANCE ENDOF 'E' OF _SHOW.TRANSMITTANCE.DATA.TEXT.TYPE ENDOF 'F' OF _PARP ( INCLUDE P.F ) ENDOF k_esc +k_control of endof 'P' +k_control +k_shift of GetHandle: DEMOW Setup: ThePrinter endof 'C' +k_control of false copy-demo-bitmap endof 'C' +k_control +k_shift of true copy-demo-bitmap endof 'X' +k_control of false copy-demo-bitmap k_esc pushkey endof endcase \ exit.windemo? @ \ SHOW.TRANSMITANCE ( until ) again ; \ ' windemo turnkey windemo \ build an application on disk \ 5 pause-seconds : WINDEMO1 115200 _COM1 WINDEMO.n ; : WINDEMO2 115200 _COM2 WINDEMO.n ; : WINDEMO3 115200 _COM3 WINDEMO.n ; : WINDEMO4 115200 _COM4 WINDEMO.n ; : WINDEMO5 115200 _COM5 WINDEMO.n ; : WINDEMO6 115200 _COM6 WINDEMO.n ; : WINDEMO7 115200 _COM7 WINDEMO.n ; \S : MULTIPLE.UART.PROCESSING ( ... ) FINAL @ INITIAL @ CH.1 DO I VI READ.A/D.1&2.PLOT SLEEP SAMPLING.TIME @ MS INCREMENT @ +LOOP FINAL @ INITIAL @ CH.2 DO I VI READ.A/D.1&2.PLOT SLEEP SAMPLING.TIME @ MS INCREMENT @ +LOOP FINAL @ INITIAL @ CH.3 DO I VI READ.A/D.1&2.PLOT SLEEP SAMPLING.TIME @ MS INCREMENT @ +LOOP ; CH.n.MODE @ CASE 0 OF VV ENDOF 1 OF VI ENDOF ENDCASE ; T: TALK.WITH.CH.n ( CH.n ... ) ` R0=1 T: TALK.WITH.ME ( CH.n ... ) BEGIN' ?RX ` AxR0 \ ME? IF'A=0 GET.COMMAND EXECUTE.COMMAND ELSE' ` A=0FF ( 50 ) MS' ENDIF' AGAIN' \S A useful trick for multiple UARTS is at the start of the timer interrupt, to read all the rx bits in one go, and write the tx bits from the previous interrupt, then do the processing - that way differing processing times don't introduce jitter. If you have other ints, you want your soft UART timer int to be 3x or 4x the baudrate to get optimal bit-centering