home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / STFORMAT / STF04.MSA / 2ND_SIDE_GFADEMOS_WINDOW1.LST < prev    next >
File List  |  1989-09-27  |  17KB  |  483 lines
  1. '                 Window Demo --- GFA Systemtechnik 1986 ---
  2. '                Extensive work by John Tal/Michtron/1987
  3. '
  4. '
  5. '                Works in Color(med-rez) or Mono(hi-rez)
  6. '
  7. '
  8. Dim Test$(78)
  9. '
  10. True=-1
  11. False=0
  12. '
  13. ' bios function call for screen resolution and returned values
  14. Bios_rez=4
  15. Mrez=1
  16. Hrez=2
  17. '
  18. ' screen size (to be used with Rez)
  19. Scr_org_x=640
  20. Scr_org_y=200
  21. '
  22. ' get screen resolution from Xbios/Trap #14, opcode=Bios_rez=4
  23. Rez=Xbios(Bios_rez)
  24. '
  25. ' calc to allow this demo to function in med or Hi rez
  26. Scr_max_y=Scr_org_y*Rez-1
  27. Scr_max_x=Scr_org_x-1
  28. '
  29. ' GEM opcodes
  30. W_get=104
  31. W_set=105
  32. W_calc=108
  33. '
  34. ' working margin on GFA basic screen at top
  35. Top_margin=11*Rez
  36. '
  37. ' vars for tracking window full state
  38. Wfull=False
  39. Old_fulx=0
  40. Old_fuly=Top_margin
  41. Old_fulw=Scr_max_x
  42. Old_fulh=Scr_max_y-Top_margin
  43. '
  44. ' window attributes(&HFFF=all active)
  45. Wattribs=&HFFF
  46. '
  47. ' event messages return values in Menu
  48. Wclosed=22
  49. Wfulled=23
  50. Warrowed=24
  51. Whslided=25
  52. Wvslided=26
  53. Wsized=27
  54. Wmoved=28
  55. Wguess=30
  56. '
  57. ' vars to track sliders
  58. Slid_horz_pos=1
  59. Slid_vert_pos=1
  60. Slid_horz_size=1
  61. Slid_vert_size=1
  62. '
  63. ' vars to track and calc text size
  64. Char_cell_width=8
  65. Char_cell_height=8*Rez
  66. '
  67. ' position in string array for upper left corner of window
  68. Txt_char=1
  69. Txt_line=1
  70. '
  71. ' window size in chars for text to display
  72. Txt_wind_w=1
  73. Txt_wind_h=1
  74. Tot_txt_len=92
  75. Tot_txt_lines=77
  76. '
  77. ' create sample data to manupilate within window
  78. Test$(1)="                                           For further information contact:                 "
  79. Test$(2)="                                        Gordon Monnier                                      "
  80. Test$(3)="                                        President, MichTron Inc.                            "
  81. Test$(4)="                                                                                            "
  82. Test$(5)="For Immediate Release:                                                                      "
  83. Test$(6)="GFA BASIC by GFA Systemtechnik                                                              "
  84. Test$(7)="     MichTron is  pleased to  announce the release of GFA BASIC.  GFA BASIC                 "
  85. Test$(8)="was developed  by our  friends in  Germany, GFA Systemtechnik.  MichTron is                 "
  86. Test$(9)="delighted that  we can  continue to  bring you  dynamic and useful programs                 "
  87. Test$(10)="from both  home and  abroad.   Besides this  package from  Germany, we  are                 "
  88. Test$(11)="currently releasing new programs from England, Scotland, and France.                        "
  89. Test$(12)="     GFA BASIC is a high level language for the ATARI ST that is as easy to                 "
  90. Test$(13)="program as BASIC yet offers full access to system features and an execution                 "
  91. Test$(14)="speed that rivals assembly language.                                                        "
  92. Test$(15)="     The concept  behind the  development of  GFA BASIC  was  not  to  make                 "
  93. Test$(16)="further minor  improvements in BASICs programming language but to develop a                 "
  94. Test$(17)="totally new  form  of  BASIC  which  would  meet  the  following  criteria:                 "
  95. Test$(18)="structured programming  should be  made possible  in its entirety, everyone                 "
  96. Test$(19)="who has  programmed in  BASIC should  be able to use the new Interpreter in                 "
  97. Test$(20)="the shortest  time possible,  and the  advantages already  present in BASIC                 "
  98. Test$(21)="should be found in the newly developed BASIC.                                               "
  99. Test$(22)="     GFA BASIC  offers the  user a  BASIC  Interpreter  which,  apart  from                 "
  100. Test$(23)="entirely fulfilling  the before  mentioned conditions, also offers the user                 "
  101. Test$(24)="other advantages.   The GFA BASIC Interpreter is very compact; it uses only                 "
  102. Test$(25)="55 KBytes  of 'precious'  memory on  your ATARI ST.  The Interpreter has an                 "
  103. Test$(26)="extremely fast  processing speed; it needs less than half a second to carry                 "
  104. Test$(27)="out an empty FOR-NEXT loop 10,000 times.                                                    "
  105. Test$(28)="     GFA BASIC  also makes structured programming possible.  In order to do                 "
  106. Test$(29)="this, several additional structure commands were added to the list of BASIC                 "
  107. Test$(30)="commands.  For example:  DO ... LOOP, WHILE ... WEND, REPEAT ... UNTIL, and                 "
  108. Test$(31)="PROCEDURE (with local variables) were among those added.  It was considered                 "
  109. Test$(32)="necessary to  limit the  amount of  commands to  one per  line to  keep the                 "
  110. Test$(33)="structure of the program simple.                                                            "
  111. Test$(34)="     The functions which, GFA BASIC is capable of, can be differentiated by                 "
  112. Test$(35)="two types:   numerical  and  character  string  functions,  depending  upon                 "
  113. Test$(36)="whether the  result of  the operation  is a  number or  a character string.                 "
  114. Test$(37)="There are two types of character string operators:  those character strings                 "
  115. Test$(38)="which are  linked by  the function  + and  the character  string  functions                 "
  116. Test$(39)="LEFT$, RIGHT$,  MID$, SPACE$,  STRING$, and  STR$.  The numerical operators                 "
  117. Test$(40)="can be  divided into  four categories:   Arithmetic  functions,  Comparison                 "
  118. Test$(41)="functions, Logical functions, and Numerical functions.                                      "
  119. Test$(42)="     When programming  with GFA  BASIC you  will be using two screens which                 "
  120. Test$(43)="can be  used independently  of one another.  One is the Editor screen which                 "
  121. Test$(44)="you will  see on the command line at the top of the screen.  The other is a                 "
  122. Test$(45)="display screen  which shows  the results of the program commands which have                 "
  123. Test$(46)="been entered.   This excellent, full-screen editor includes word processor-                 "
  124. Test$(47)="style features  such as  search and  replace, block copy, move, delete, and                 "
  125. Test$(48)="more.                                                                                       "
  126. Test$(49)="     GFA BASIC  is capable  of incorporating  the  features  found  in  GEM                 "
  127. Test$(50)="including windows, drop-down menus, and alert boxes.  Various menu commands                 "
  128. Test$(51)="let you  handle GEM  drop-down menus  with ease and efficiency.  Four mouse                 "
  129. Test$(52)="commands makes  using the mouse a snap.  Other key words allow for the easy                 "
  130. Test$(53)="use of windows and alert boxes.                                                             "
  131. Test$(54)="     GFA BASIC  offers everything  found in  conventional BASICs  plus much                 "
  132. Test$(55)="more.   GFA BASIC  resembles Modula-2  or Pascal  code with  the ability to                 "
  133. Test$(56)="accept parameters  from the  main program as well as using local variables.                 "
  134. Test$(57)="Line numbers  are eliminated in favor of meaningful labels, and subroutines                 "
  135. Test$(58)="take the  form of  procedures which  are called by name.  Also, the various                 "
  136. Test$(59)="menu commands lets you handle GEM drop-down menus with ease and efficiency.                 "
  137. Test$(60)="     Two impressive  features of  GFA BASIC  are the  EXEC and C: commands.                 "
  138. Test$(61)="EXEC allows  you to load and execute a non-BASIC ST application from within                 "
  139. Test$(62)="a BASIC program.  The C: command calls a routine written and compiled in C.                 "
  140. Test$(63)="Both commands  purport to  allow full  parameter passing.   GFA  BASIC also                 "
  141. Test$(64)="supports the  unary *  operator for  C-style pointer  operations.  Together                 "
  142. Test$(65)="these capabilities  pave the  way for  an intriguing  sort of program which                 "
  143. Test$(66)="efficiently blends  BASIC  code  with  program  modules  written  in  other                 "
  144. Test$(67)="languages.                                                                                  "
  145. Test$(68)="     GFA BASIC  sports an  abundance of  new graphic  commands, along  with                 "
  146. Test$(69)="Unix-style DOS  functions, and  a host of additions to the keywords already                 "
  147. Test$(70)="offered by ST BASIC.                                                                        "
  148. Test$(71)="     GFA BASIC  not only demonstrates what BASIC can be on the ATARI ST but                 "
  149. Test$(72)="it points  the way  to an  entirely new  sort of BASIC - one that's able to                 "
  150. Test$(73)="reach  beyond   its  own  confines  and  incorporate  routines  from  other                 "
  151. Test$(74)="languages, actually stretching the definition of BASIC itself.                              "
  152. Test$(75)="     GFA BASIC  is available  through MichTron  at the low price of $79.95.                 "
  153. Test$(76)="MichTron is  the largest  distributor of  software for  the Atari ST and is                 "
  154. Test$(77)="proud to welcome GFA BASIC into its family of computer programs.                            "
  155. Test$(78)=Space$(92)
  156. '
  157. ' defined fill pattern & fill entire screen
  158. ' for color - 3=color=green,   2,8=pattern=solid
  159. ' for mono  - 1=color=black,   2,4=pattern=med screen(dots)
  160. '
  161. If Rez=Mrez Then
  162.   Deffill 3,2,8
  163. Else
  164.   Deffill 1,2,4
  165. Endif
  166. Pbox 0,0,Scr_max_x,Scr_max_y
  167. '
  168. ' assign our vars to match(point to) Window paramater table
  169. Attr=Windtab+2
  170. Xpos=Windtab+4
  171. Ypos=Windtab+6
  172. Width=Windtab+8
  173. Height=Windtab+10
  174. '
  175. ' set up window with all attributes functioning
  176. Dpoke Attr,Wattribs
  177. '
  178. ' assign title for window 1
  179. Titlew 1,"Window Demo"
  180. '
  181. ' windows dimensions based on screen resolution
  182. Wx=100
  183. Wy=29*Rez
  184. Ww=400
  185. Wh=180*Rez
  186. '
  187. ' ** set up handling for GEM messages **
  188. On Menu Message Gosub Msg_event
  189. '
  190. ' open and clear window 1
  191. @Open_window(Wx,Wy,Ww,Wh)
  192. '
  193. ' *** Main program loop ***
  194. Do
  195.   ' break out on GEM message
  196.   On Menu
  197. Loop
  198. ' *************************
  199. '
  200. ' ** handler for any message
  201. '
  202. Procedure Msg_event
  203.   '  menu() array = event message buffer array +1
  204.   M=Menu(1)
  205.   If M=Wclosed
  206.     Alert 2,"End WindDemo|    Program?",1,"Yes|No",A
  207.     If A=1
  208.       Closew 1
  209.       Edit
  210.     Endif
  211.   Endif
  212.   If M=Wfulled
  213.     @Setwindfull(Menu(5),Menu(6),Menu(7),Menu(8))
  214.   Endif
  215.   If M=Warrowed
  216.     On Menu(5)+1 Gosub Page_up,Page_dn,Row_up,Row_dn,Page_lt,Page_rt,Col_rt,Col_lt
  217.   Endif
  218.   If M=Whslided
  219.     @Sethslid(Menu(5))
  220.   Endif
  221.   If M=Wvslided
  222.     @Setvslid(Menu(5))
  223.   Endif
  224.   If M=Wsized
  225.     @Setwindsiz(Wx,Wy,Ww,Wh)
  226.   Endif
  227.   If M=Wmoved
  228.     @Setwindmov(Menu(5),Menu(6),Menu(7),Menu(8))
  229.   Endif
  230.   If M=Wguess
  231.     Print "Hurrah"
  232.   Endif
  233. Return
  234. '
  235. ' *** Routines to service Msg_event procedure ***
  236. '
  237. Procedure Setwindfull(X,Y,W,H)
  238.   ' request to full window
  239.   Closew 1
  240.   ' set Windowtable with new values/save current
  241.   Wfull=Not Wfull
  242.   Swap Old_fulx,X
  243.   Swap Old_fuly,Y
  244.   Swap Old_fulw,W
  245.   Swap Old_fulh,H
  246.   Wx=X
  247.   Wy=Y
  248.   Ww=W
  249.   Wh=H
  250.   @Open_window(X,Y,W,H)
  251. Return
  252. '
  253. Procedure Page_up
  254.   Txt_line=Max(1,Txt_line-Txt_wind_h)
  255.   '  Clearw 1
  256.   @Calc_vert_pos
  257.   @Setwindvslid(Slid_vert_pos)
  258.   @Draw_window
  259. Return
  260. '
  261. Procedure Page_dn
  262.   Txt_line=Min(Txt_line+Txt_wind_h,Tot_txt_lines-Txt_wind_h+1)
  263.   '  Clearw 1
  264.   @Calc_vert_pos
  265.   @Setwindvslid(Slid_vert_pos)
  266.   @Draw_window
  267. Return
  268. '
  269. Procedure Row_up
  270.   If Txt_line>1 Then
  271.     Dec Txt_line
  272.     '    Clearw 1
  273.     @Calc_vert_pos
  274.     @Setwindvslid(Slid_vert_pos)
  275.     @Draw_window
  276.   Endif
  277. Return
  278. '
  279. Procedure Row_dn
  280.   If Txt_line+Txt_wind_h<=Tot_txt_lines Then
  281.     Inc Txt_line
  282.     '    Clearw 1
  283.     @Calc_vert_pos
  284.     @Setwindvslid(Slid_vert_pos)
  285.     @Draw_window
  286.   Endif
  287. Return
  288. '
  289. Procedure Page_lt
  290.   Txt_char=Max(1,Txt_char-Txt_wind_w)
  291.   '  Clearw 1
  292.   @Calc_horz_pos
  293.   @Setwindhslid(Slid_horz_pos)
  294.   @Draw_window
  295. Return
  296. '
  297. Procedure Page_rt
  298.   Txt_char=Min(Txt_char+Txt_wind_w,Tot_txt_len-Txt_wind_w+1)
  299.   '  Clearw 1
  300.   @Calc_horz_pos
  301.   @Setwindhslid(Slid_horz_pos)
  302.   @Draw_window
  303. Return
  304. '
  305. Procedure Col_lt
  306.   If Txt_char+Txt_wind_w<=Tot_txt_len Then
  307.     Inc Txt_char
  308.     '    Clearw 1
  309.     @Calc_horz_pos
  310.     @Setwindhslid(Slid_horz_pos)
  311.     @Draw_window
  312.   Endif
  313. Return
  314. '
  315. Procedure Col_rt
  316.   If Txt_char>1 Then
  317.     Dec Txt_char
  318.     '    Clearw 1
  319.     @Calc_horz_pos
  320.     @Setwindhslid(Slid_horz_pos)
  321.     @Draw_window
  322.   Endif
  323. Return
  324. '
  325. Procedure Sethslid(Mark)
  326.   ' set pos of horz slider, service routine for user moving slider directly
  327.   ' must adjust starting horz text pos to match 0..1000 slider range
  328.   '  Clearw 1
  329.   I1=Tot_txt_len-Txt_wind_w+1
  330.   Txt_char=Trunc(Mark/1000*I1+0.5)
  331.   Dpoke Gintin,Dpeek(Windtab)
  332.   Dpoke Gintin+2,8
  333.   Dpoke Gintin+4,Mark
  334.   Gemsys W_set
  335.   @Draw_window
  336. Return
  337. '
  338. Procedure Setvslid(Mark)
  339.   ' set pos of vert slider, service routine for user moving slider directly
  340.   ' must adjust starting vert text pos to match 0..1000 slider range
  341.   '  Clearw 1
  342.   I1=Tot_txt_lines-Txt_wind_h+1
  343.   Txt_line=Max(1,Trunc(Mark/1000*I1+0.5))
  344.   Dpoke Gintin,Dpeek(Windtab)
  345.   Dpoke Gintin+2,9
  346.   Dpoke Gintin+4,Mark
  347.   Gemsys W_set
  348.   @Draw_window
  349. Return
  350. '
  351. Procedure Setwindsiz(X,Y,W,H)
  352.   ' handles sized and fulled windows
  353.   Closew 1
  354.   X=Menu(5)
  355.   Y=Menu(6)
  356.   W=Menu(7)
  357.   H=Menu(8)
  358.   If Wfull Then
  359.     Old_fulx=Wx
  360.     Old_fuly=Wy
  361.     Old_fulw=Ww
  362.     Old_fulh=Wh
  363.     Wx=X
  364.     Wy=Y
  365.     Ww=W
  366.     Wh=H
  367.     Wfull=False
  368.   Endif
  369.   @Open_window(X,Y,W,H)
  370. Return
  371. '
  372. Procedure Setwindmov(X,Y,W,H)
  373.   ' window has been moved, set Windowtable with new values
  374.   Closew 1
  375.   @Open_window(X,Y,W,H)
  376. Return
  377. '
  378. ' *** open window ***
  379. '
  380. Procedure Open_window(X,Y,W,H)
  381.   ' main open service routine for procedures in this program
  382.   Dpoke Xpos,X
  383.   Dpoke Ypos,Y
  384.   ' force window to open on multiple of character cell size
  385.   ' to show complete text characters in window
  386.   ' W=Char_cell_width*(W Div Char_cell_width)-3*Rez
  387.   ' H=Char_cell_height*(H Div Char_cell_height)-1*Rez
  388.   Dpoke Width,W
  389.   Dpoke Height,H
  390.   '
  391.   Openw 1
  392.   Clearw 1
  393.   ' get working co-ords of new window position
  394.   @Calc_txt_wind
  395.   '  make sure that fulled/expanding window resets beginning txt_char/line if necessary
  396.   Txt_char=Min(Txt_char,Tot_txt_len-Trunc((Wtemp/Char_cell_width)+0.5)+1)
  397.   Txt_line=Min(Txt_line,Tot_txt_lines-Trunc((Htemp/Char_cell_height)+0.5)+1)
  398.   @Calc_horz_pos
  399.   @Calc_vert_pos
  400.   @Size_sliders(Xtemp,Ytemp,Wtemp,Htemp)
  401.   @Setwindhslid(Slid_horz_pos)
  402.   @Setwindvslid(Slid_vert_pos)
  403.   @Draw_window
  404. Return
  405. '
  406. ' *** Support routines for displaying text in window
  407. '
  408. Procedure Calc_txt_wind
  409.   ' calc the size of the text window for Txt_wind_w & h
  410.   ' also prepares _temp vars for window open
  411.   Dpoke Gintin,Dpeek(Windtab)
  412.   Dpoke Gintin+2,4
  413.   Gemsys W_get
  414.   Xtemp=Dpeek(Gintout+2)
  415.   Ytemp=Dpeek(Gintout+4)
  416.   Wtemp=Dpeek(Gintout+6)
  417.   Htemp=Dpeek(Gintout+8)
  418.   Txt_wind_w=Wtemp Div Char_cell_width
  419.   Txt_wind_h=Htemp Div Char_cell_height
  420. Return
  421. '
  422. Procedure Draw_window
  423.   ' draw text within window
  424.   ' calc avail size of window in chars and *Text* into window what we need
  425.   @Calc_txt_wind
  426.   For I1=0 To Txt_wind_h
  427.     Text 2,7*Rez+I1*Char_cell_height,0,Mid$(Test$(Txt_line+I1),Txt_char,Txt_wind_w)
  428.   Next I1
  429. Return
  430. '
  431. ' *** Slider support routines ***
  432. '
  433. Procedure Setwindhslid(Mark)
  434.   ' set position of horz slider, service routine for horz page & arrow
  435.   Slid_horz_pos=Mark
  436.   Dpoke Gintin,Dpeek(Windtab)
  437.   Dpoke Gintin+2,8
  438.   Dpoke Gintin+4,Mark
  439.   Gemsys W_set
  440. Return
  441. '
  442. Procedure Setwindvslid(Mark)
  443.   ' set position of vert slider
  444.   Slid_vert_pos=Mark
  445.   Dpoke Gintin,Dpeek(Windtab)
  446.   Dpoke Gintin+2,9
  447.   Dpoke Gintin+4,Mark
  448.   Gemsys W_set
  449. Return
  450. '
  451. Procedure Size_sliders(Xtemp,Ytemp,Wtemp,Htemp)
  452.   ' set horizontal (bottom) slider size for this window
  453.   @Calc_horz(Wtemp)
  454.   Dpoke Gintin,Dpeek(Windtab)
  455.   Dpoke Gintin+2,15
  456.   Dpoke Gintin+4,Slid_horz_size
  457.   Gemsys W_set
  458.   ' set vertical (side) slider size for window
  459.   @Calc_vert(Htemp)
  460.   Dpoke Gintin,Dpeek(Windtab)
  461.   Dpoke Gintin+2,16
  462.   Dpoke Gintin+4,Slid_vert_size
  463.   Gemsys W_set
  464. Return
  465. '
  466. Procedure Calc_horz(Wtemp)
  467.   Slid_horz_size=Trunc((Wtemp/(Tot_txt_len*Char_cell_width))*1000+0.5)
  468. Return
  469. '
  470. Procedure Calc_vert(Htemp)
  471.   Slid_vert_size=Trunc((Htemp/(Tot_txt_lines*Char_cell_height))*1000+0.5)
  472. Return
  473. '
  474. Procedure Calc_horz_pos
  475.   Slid_horz_pos=Abs(Trunc(Txt_char/(Tot_txt_len-Txt_wind_w)*1000))-21
  476. Return
  477. '
  478. Procedure Calc_vert_pos
  479.   Slid_vert_pos=Abs(Trunc(Txt_line/(Tot_txt_lines-Txt_wind_h)*1000))-21
  480. Return
  481. '
  482. ' --- End. ---
  483.