#FLOO # graftest.floo: Graphics test program for Floo, using Glk. # Designed by Andrew Plotkin # http://www.eblong.com/zarf/glk/floo/index.html # This program is in the public domain. # Define an input buffer. /inbuffer 80 string def # Function: str ch findchar => val # This finds the first position where ch appears in str, or -1 if there # is none. /findchar { /fxval -1 def /fxch exch def /fxstr exch def 0 1 fxstr strlen 1 sub { dup fxstr exch get fxch eq { /fxval exch def exit } { pop } ifelse } for fxval } def # Function: str trimwhite => str # This removes spaces from the beginning and end of str. /trimwhite { /txval -1 def /txch 32 def /txstr exch def 0 1 txstr strlen 1 sub { dup txstr exch get txch ne { /txval exch def exit } { pop } ifelse } for txval -1 ne { /txstr txstr txval txstr strlen txval sub getinterval def } if txstr strlen 1 sub -1 0 { dup txstr exch get 32 eq { txstr exch 0 put } { pop exit } ifelse } for txstr } def # Function: str parseint => int # This extracts an integer from str. It does no error-checking at all; # it just ignores all non-digits. /parseint { /px exch def /pxlen px strlen def /pval 0 def 0 1 pxlen { px exch get /pchar exch def pchar 48 ge pchar 57 le and { /pval pval 10 mul pchar 48 sub add def } if } for pval } def # Function: str parsecolor => int # This recognizes a color name, and returns the color as an integer, # using Glk's 32-bit encoding. /parsecolor { /px exch def /pval -1 def px "red" eq { /pval 0x00FF0000 def } if px "green" eq { /pval 0x0000FF00 def } if px "blue" eq { /pval 0x000000FF def } if px "orange" eq { /pval 0x00FF8000 def } if px "purple" eq { /pval 0x00C000FF def } if px "yellow" eq { /pval 0x00FFFF00 def } if px "black" eq { /pval 0x00000000 def } if px "white" eq { /pval 0x00FFFFFF def } if px "grey" eq { /pval 0x00808080 def } if px "lilac" eq { /pval 0x00AA55E0 def } if pval -1 eq { "Unknown color; using black.\n" glk_put_string /pval 0x00000000 def } if pval } def # Variables used for mouse-clicking. When a mouse event is received, # the event loop pushes the coordinates on the stack, and then simply # executes the contents of mouseproc. # /mouseconst 0 def /mouseproc /printproc def # Function: Print the coordinates. This is a little tricky, since # there's input pending. /printproc { mainwin true glk_cancel_line_event /ev exch def "Mouse click at " glk_put_string exch echo ", " glk_put_string echo ".\n" glk_put_string "\n>" glk_put_string mainwin inbuffer ev 2 get glk_request_line_event } def # Function: Draw a solid square. /solidproc { /jx exch def /ix exch def grafwin mouseconst ix 24 sub jx 24 sub 48 48 glk_window_fill_rect } def # Function: Erase a solid square. /eraseproc { /jx exch def /ix exch def grafwin ix 24 sub jx 24 sub 48 48 glk_window_erase_rect } def # Function: Draw an image. /imageproc { /jx exch def /ix exch def grafwin mouseconst ix jx glk_image_draw pop } def # Function: Draw an image, scaled. /scaleproc { /jx exch def /ix exch def grafwin mouseconst 0 0 ix jx glk_image_draw_scaled pop } def # Now the actual program begins. # Open the main window. 0 0 0 wintype_TextBuffer 1 glk_window_open /mainwin exch def # If we couldn't do that, forget it. mainwin 0 eq { glk_exit } if # Set the current stream to the main window stream. mainwin glk_set_window # Print an opening message. "GrafTest Release 1.\n" glk_put_string "Welcome to a simple sample graphics test in Floo.\n" glk_put_string "Type \"help\" for the list of commands.\n" glk_put_string # Open the graphics window. mainwin winmethod_Below winmethod_Proportional or 40 wintype_Graphics 2 glk_window_open /grafwin exch def # If we couldn't do that, forget it. grafwin 0 eq { "The graphics window could not be opened.\n" glk_put_string glk_exit } if # Request mouse events in the graphics window. grafwin glk_request_mouse_event # Begin the program loop. { # Print the prompt. "\n>" glk_put_string # Request a line of input. mainwin inbuffer 0 glk_request_line_event # Here's the event loop. { glk_select /ev exch def # ev is now a four-element event array: [type window val1 val2] # Define evtype to the first element (type) ev 0 get /evtype exch def # If it was a line input event, exit the event loop. evtype evtype_LineInput eq { exit } if # If it was a mouse input event, run the mouseproc routine. evtype evtype_MouseInput eq { ev 2 get ev 3 get mouseproc load exec # Request another click. grafwin glk_request_mouse_event } if } loop # Copy the buffer at its returned length. /wholecmd inbuffer 0 ev 2 get getinterval def # This loop goes through the command, dividing it up at periods. { wholecmd "" eq { # done with wholecmd. exit } if # Set onecmd to the text up to the first period. wholecmd 46 findchar # find '.' /ix exch def ix -1 eq { /onecmd wholecmd def /wholecmd "" def } { /onecmd wholecmd 0 ix getinterval def /wholecmd wholecmd ix 1 add wholecmd strlen ix 1 add sub getinterval def } ifelse # Look for the first space, to divide verb from noun. /onecmd onecmd trimwhite def /noun "" def onecmd 32 findchar /ix exch def ix -1 eq { /noun "" def } { /noun onecmd ix 1 add onecmd strlen ix 1 add sub getinterval trimwhite def /onecmd onecmd 0 ix getinterval def } ifelse # Figure out what verb it is. onecmd "quit" eq { "Thanks for playing.\n" glk_put_string glk_exit } if onecmd "info" eq { noun "" eq { "Info on what image?\n" glk_put_string continue } if /ix noun parseint def ix true true glk_image_get_info 0 ne { "Image " glk_put_string ix echo " exists; " glk_put_string echo " x " glk_put_string echo " pixels.\n" glk_put_string } { pop pop "Image " glk_put_string ix echo " does not exist.\n" glk_put_string } ifelse continue } if onecmd "background" eq { noun "" eq { "Background to what color?\n" glk_put_string continue } if /ix noun parsecolor def "Setting graphics window background color.\n" glk_put_string grafwin ix glk_window_set_background_color continue } if onecmd "clear" eq { grafwin glk_window_clear "Graphics window cleared.\n" glk_put_string continue } if onecmd "coord" eq { /mouseproc /printproc def "Mouse clicks will show coordinates.\n" glk_put_string continue } if onecmd "solid" eq { noun "" eq { "Mouse squares of what color?\n" glk_put_string continue } if /mouseconst noun parsecolor def "Mouse clicks will produce solid squares.\n" glk_put_string /mouseproc /solidproc def continue } if onecmd "erase" eq { "Mouse clicks will erase solid squares.\n" glk_put_string /mouseproc /eraseproc def continue } if onecmd "image" eq { noun "" eq { "Mouse which image?\n" glk_put_string continue } if /mouseconst noun parseint def "Mouse clicks will draw image " glk_put_string mouseconst echo ".\n" glk_put_string /mouseproc /imageproc def continue } if onecmd "scale" eq { noun "" eq { "Mouse scale which image?\n" glk_put_string continue } if /mouseconst noun parseint def "Mouse clicks will scale image " glk_put_string mouseconst echo ".\n" glk_put_string /mouseproc /scaleproc def continue } if onecmd "up" eq { noun "" eq { "Print which image?\n" glk_put_string continue } if mainwin noun parseint imagealign_InlineUp 0 glk_image_draw pop continue } if onecmd "down" eq { noun "" eq { "Print which image?\n" glk_put_string continue } if mainwin noun parseint imagealign_InlineDown 0 glk_image_draw pop continue } if onecmd "center" eq { noun "" eq { "Print which image?\n" glk_put_string continue } if mainwin noun parseint imagealign_InlineCenter 0 glk_image_draw pop continue } if onecmd "leftmargin" eq { noun "" eq { "Print which image?\n" glk_put_string continue } if mainwin noun parseint imagealign_MarginLeft 0 glk_image_draw pop continue } if onecmd "rightmargin" eq { noun "" eq { "Print which image?\n" glk_put_string continue } if mainwin noun parseint imagealign_MarginRight 0 glk_image_draw pop continue } if onecmd "break" eq { mainwin glk_window_flow_break continue } if onecmd "echo" eq { noun "" eq { /noun "\n" def } if noun glk_put_string continue } if onecmd "yada" eq { "One" glk_put_string " two three four five six seven eight nine ten eleven twelve" dup glk_put_string dup glk_put_string dup glk_put_string dup glk_put_string dup glk_put_string glk_put_string ".\n" glk_put_string continue } if onecmd "help" eq { "help: This list.\n" glk_put_string "info N: Show whether image N exists, and its size if so.\n" glk_put_string "background COL: Set the graphics window background color.\n" glk_put_string "clear: Clear the graphics window to its background color.\n" "solid COL: Mouse clicks in the graphics window \ will draw solid squares of the given color.\n" glk_put_string "erase: Mouse clicks in the graphics window \ will erase solid squares to the background color.\n" glk_put_string "image N: Mouse clicks in the graphics window \ will draw image N.\n" glk_put_string "scale N: Mouse clicks in the graphics window \ will draw image N, scaled from the top left to the click.\n" glk_put_string "coord: Mouse clicks will cause their coordinates to be \ printed. (default)\n" glk_put_string "up N: Print image N inline in the text window, aligned up.\n" glk_put_string "down N: Print image N inline in the text window, \ aligned down.\n" glk_put_string "center N: Print image N inline in the text window, \ aligned center.\n" glk_put_string "leftmargin N: Print image N in the left margin; subsequent \ printing will flow around.\n" glk_put_string "rightmargin N: Print image N in the right margin; subsequent \ printing will flow around.\n" glk_put_string "break: Flow-break in the text window.\n" glk_put_string "echo STRING: Print the given string. If none is given, print a \ newline.\n" glk_put_string "yada: Print a lot of text, followed by a newline.\n" glk_put_string "\nYou can string several commands together, separated by \ periods, to test the layout of combinations of images and text.\n" glk_put_string "\nColors are parsed stupidly: you must enter one of the \ constants \ red, blue, yellow, green, orange, purple, white, black, grey, lilac.\n" glk_put_string continue } if "I don't know the command \"" glk_put_string onecmd glk_put_string "\".\n" glk_put_string } loop } loop