Author Topic: 🎄🎁✨ Holiday Season - are you ready to code?  (Read 18450 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #120 on: December 24, 2020, 11:35:31 am »
I did have to extend the original track though... Can you spot the patch?

Dav, don't spill it 😂

Um... once the work is finished, probably not a good idea to point out the bugs.

My brother the perfectionist does that often and danged if those hidden bugs don't look 1000 x's bigger than they were before he pointed them out!

FellippeHeitor

  • Guest
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #121 on: December 24, 2020, 11:50:03 am »
😂

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #122 on: December 26, 2020, 01:29:04 am »
x-mas-wrap.jpg


Code: QB64: [Select]
  1. beta% = 1 ' Testing text
  2. debug% = 0 ' Debugger stats.
  3. scrb.opt = 0 ' Variable size scrollbar box.
  4.  
  5. DIM scrn AS my_scrn
  6. DIM page AS my_page
  7. DIM margin AS my_margin
  8. DIM scrb AS my_scrb
  9. DIM cursor AS my_cursor
  10. DIM mb AS my_mb
  11.  
  12.  
  13. TYPE my_scrn
  14.     w AS INTEGER
  15.     h AS INTEGER
  16.  
  17. TYPE my_page
  18.     w AS INTEGER
  19.     h AS INTEGER
  20.     c AS INTEGER
  21.  
  22. TYPE my_margin
  23.     t AS INTEGER
  24.     b AS INTEGER
  25.     l AS INTEGER
  26.     r AS INTEGER
  27.  
  28. TYPE my_scrb
  29.     t AS INTEGER
  30.     b AS INTEGER
  31.     l AS INTEGER
  32.     x AS INTEGER
  33.     i AS INTEGER
  34.     d AS INTEGER
  35.     h AS INTEGER
  36.     s AS INTEGER
  37.     opt AS INTEGER
  38.     adjust AS INTEGER
  39.  
  40. TYPE my_cursor
  41.     find AS INTEGER
  42.     scbrrow AS INTEGER ' row + scr
  43.     scbrcol AS INTEGER ' POS(0)
  44.     holdscr AS INTEGER ' Holds scr
  45.     holdrow AS INTEGER ' Holds row
  46.     holdscrbx AS INTEGER ' Holds scrb.x
  47.     top AS INTEGER
  48.     bot AS INTEGER
  49.  
  50. TYPE my_mb
  51.     l AS INTEGER
  52.     r AS INTEGER
  53.     m AS INTEGER
  54.     w AS INTEGER
  55.     drag AS INTEGER
  56.     dragon AS INTEGER
  57.  
  58. GOSUB setvariables
  59.  
  60. GOSUB getvar_setscrn
  61.  
  62. IF beta% THEN GOSUB betatestfile
  63.  
  64.     GOSUB getkey
  65.  
  66.     IF updatescrn% THEN
  67.  
  68.         GOSUB keyeffect
  69.  
  70.         GOSUB determinewrap
  71.  
  72.         IF wrap.on% THEN GOSUB wrapper
  73.  
  74.         GOSUB displaydoc
  75.  
  76.         updatescrn% = 0
  77.     END IF
  78.  
  79.  
  80. ' **************************** GOSUB ROUTINES *******************************
  81.  
  82. setvariables:
  83. scrn.h = 25
  84. margin.t = 3
  85. margin.b = 3
  86. margin.l = 5
  87. margin.r = 5
  88. border.thk = 0
  89. border.stl = 1
  90. ins% = 7
  91. ovm% = 1 ' Change this to 0 for no over margin cursoring. 0 needed if right margin is at edge of screen.
  92. scrn.w = 80
  93. scrn.h = 25
  94. dwidth = scrn.w - (margin.l + margin.r): dwidth2 = dwidth + 2
  95. page.h = scrn.h - (margin.t + margin.b + CINT(border.thk / border.stl + .01))
  96. page.w = scrn.w - (margin.l + margin.r + border.thk * 2)
  97. REDIM x$(page.h)
  98. c1% = 7: c2% = 0: h1% = 15: h2% = 1 ' Normal text and highlighted text colors.
  99. RETURN ' ==================================================================
  100.  
  101. betatestfile:
  102. SELECT CASE beta%
  103.     CASE 1
  104.         REDIM x$(10)
  105.         a$ = "Money's Short" + CHR$(255) + CHR$(255) + "Times Are Crap" + CHR$(255) + CHR$(255) + "Here's Your Flocking" + CHR$(255) + CHR$(255) + "Christmas App"
  106.     CASE 2
  107.         OPEN "mybetatest.txt" FOR BINARY AS #1
  108.         a$ = SPACE$(LOF(1))
  109.         GET #1, , a$
  110.         CLOSE #1
  111.         i% = (LEN(a$) / dwidth) * 2
  112.         REDIM x$(i%)
  113.         DO UNTIL INSTR(a$, CHR$(13) + CHR$(10)) = 0
  114.             a$ = MID$(a$, 1, INSTR(a$, CHR$(13) + CHR$(10)) - 1) + CHR$(255) + MID$(a$, INSTR(a$, CHR$(13) + CHR$(10)) + 2)
  115.         LOOP
  116.  
  117. wrap.on% = -1: GOSUB wrapper
  118. filled% = page.h: row = 1
  119. LOCATE margin.t + row, margin.l + 1
  120. GOSUB displaydoc
  121. GOSUB movescrollbox
  122. RETURN ' ==================================================================
  123.  
  124. keyeffect:
  125. IF a$ = "" THEN
  126.     x$(row + scr) = "" + CHR$(10): wrap.on% = -1
  127.     x$(row + scr) = a$ + CHR$(10)
  128.  
  129. aux$ = a$
  130.  
  131. IF INSTR(aux$, CHR$(4)) AND cur$ = CHR$(32) THEN
  132.     MID$(aux$, INSTR(aux$, CHR$(4)), 1) = cur$
  133.  
  134. RETURN ' ==================================================================
  135.  
  136. determinewrap:
  137. IF row > 1 OR scr > 0 THEN ' Wrap to line above analysis. Determine if the line above the text input line should wrap up the first word of the text input.
  138.     l0% = dwidth - (INSTR(x$(row - 2 + scr + 1), CHR$(10)) - 1) ' -1 chops off chr$(10)
  139.     l1% = INSTR(aux$ + CHR$(32), CHR$(32)) - 1
  140.     IF l0% >= l1% AND l1% > 0 OR LEFT$(aux$, 1) = CHR$(32) AND l0% >= 0 THEN ' The line above has enough room to wrap up the first word of the current text line.
  141.         x$(row + scr) = a$ + CHR$(10) ' The current line array is changed to the current line of text input.
  142.         a$ = MID$(x$(row - 1 + scr), 1, INSTR(x$(row - 1 + scr), CHR$(10)) - 1) ' The current line of text input is now the line above.
  143.         IF row = 1 THEN
  144.             scr = scr - 1: GOSUB scrollscrn
  145.         ELSE
  146.             row = row - 1
  147.         END IF
  148.         wrap.on% = -1
  149.         RETURN
  150.     END IF
  151.  
  152. IF RIGHT$(aux$, 1) <> CHR$(32) AND row + scr < noe OR INSTR(aux$, CHR$(255)) THEN ' Delete last space of a text line, except the last line. Current line below will wrap to line below.
  153.     wrap.on% = -1
  154.     xcurrent$ = aux$
  155.     xcurrent% = dwidth - LEN(xcurrent$)
  156.  
  157.     IF row + scr + 1 > UBOUND(x$) THEN
  158.         xbelow$ = "" ' Text line below is blank, but the line above may be too long and still needs to be wrapped down.
  159.     ELSE
  160.         xbelow$ = MID$(x$(row + 1 + scr), 1, LEN(x$(row + 1 + scr)) - 1)
  161.     END IF
  162.  
  163.     IF LEFT$(xbelow$, 1) = CHR$(32) THEN
  164.         xbelow% = 1 ' Leading space.
  165.     ELSE
  166.         xbelow% = INSTR(xbelow$ + CHR$(32), CHR$(32)) - 1
  167.     END IF
  168.  
  169.     IF xcurrent% >= xbelow% AND xbelow% > 0 OR xcurrent% < 0 THEN
  170.         wrap.on% = -1
  171.     END IF
  172.  
  173. RETURN ' ==================================================================
  174.  
  175. wrapper:
  176. start% = 1: ii% = 0: filled% = 0 ' Do not exit this routine without zeroing wrap.on%.
  177. acut$ = a$ + acut$: a$ = ""
  178.  
  179.     ' Continue to concatenate until full text line or greater is achieved or until end of doc.
  180.     DO UNTIL ii% >= noe - (row + scr) ' > is a precaution. I had one error where if failed to exit loop with = alone.
  181.         acut$ = acut$ + MID$(x$(row + scr + ii% + 1), 1, INSTR(x$(row + scr + ii% + 1), CHR$(10)) - 1) ' Cut off chr$(10).
  182.         x$(row + scr + ii% + 1) = ""
  183.         ii% = ii% + 1
  184.         IF LEN(acut$) > dwidth THEN EXIT DO
  185.     LOOP
  186.  
  187.     '==========================================================================================
  188.  
  189.     ' Cut text line and place into next text array. -------------------------------------------
  190.  
  191.     h% = INSTR(MID$(acut$, 1, dwidth + 1), CHR$(4))
  192.     IF h% THEN
  193.         IF cur$ = CHR$(32) OR cur$ = CHR$(255) THEN
  194.             MID$(acut$, h%, 1) = cur$
  195.         END IF
  196.     END IF
  197.  
  198.     IF INSTR(MID$(acut$, 1, dwidth + 1), CHR$(255)) THEN
  199.         x$ = MID$(acut$, 1, INSTR(acut$, CHR$(255)))
  200.         start% = start% + INSTR(acut$, CHR$(255))
  201.     ELSEIF RIGHT$(MID$(acut$, start%, dwidth + 1), 1) = CHR$(32) THEN
  202.         x$ = MID$(acut$, start%, dwidth + 1)
  203.         start% = start% + dwidth + 1
  204.     ELSEIF INSTR(MID$(acut$, start%, dwidth) + CHR$(32), CHR$(32)) > dwidth THEN
  205.         x$ = MID$(acut$, 1, dwidth)
  206.         start% = start% + dwidth
  207.     ELSE
  208.         IF LEN(acut$) > dwidth THEN
  209.             k% = _INSTRREV(MID$(acut$, 1, dwidth), CHR$(32)) ' Include the space so word following is left justified on current line when word proceeding wraps to top line.
  210.             x$ = MID$(acut$, 1, k%)
  211.             start% = start% + k%
  212.         ELSE
  213.             k% = LEN(acut$)
  214.             x$ = MID$(acut$, 1, k%)
  215.             start% = start% + k%
  216.         END IF
  217.     END IF
  218.  
  219.     IF h% THEN
  220.         IF cur$ = CHR$(32) OR cur$ = CHR$(255) THEN
  221.             MID$(x$, h%, 1) = CHR$(4)
  222.         END IF
  223.     END IF
  224.  
  225.     filled% = filled% + 1
  226.  
  227.     IF LEN(x$) THEN
  228.         j% = row - 1 + scr + filled%
  229.         IF j% > UBOUND(x$) THEN REDIM _PRESERVE x$(j%)
  230.         x$(j%) = x$ + CHR$(10)
  231.     END IF
  232.  
  233.     acut$ = MID$(acut$, start%)
  234.     start% = 1
  235. LOOP UNTIL ii% >= noe - (row + scr) AND acut$ = ""
  236.  
  237. ' Determine end of doc line.
  238.  
  239. IF row + scr + filled% - 1 > noe THEN
  240.     noe = filled% + row + scr - 1
  241.     FOR i% = noe TO 1 STEP -1
  242.         IF LEN(x$(i%)) AND LEFT$(x$(i%), 1) <> CHR$(10) THEN noe = i%: EXIT FOR
  243.     NEXT
  244.  
  245. x$(0) = "" ' Precaution.
  246.     IF LEFT$(x$(noe), 1) = CHR$(10) THEN x$(noe) = ""
  247.     IF x$(noe) = "" AND noe > 1 THEN noe = noe - 1 ELSE EXIT DO
  248.  
  249. q% = 1 ' Display begins 1 line above row to handle any wrap changes.
  250. wrap.on% = 0
  251. RETURN ' ==================================================================
  252.  
  253. displaydoc:
  254. ' Routine to display doc arrays to page.
  255.  
  256. IF noe >= UBOUND(x$) THEN REDIM _PRESERVE x$(noe + 1)
  257. IF UBOUND(x$) > noe + 1 THEN REDIM _PRESERVE x$(noe + 1)
  258.  
  259. j% = UBOUND(x$)
  260. FOR i% = j% TO 1 STEP -1
  261.     IF INSTR(x$(i%), CHR$(10)) = 1 THEN
  262.         x$(i%) = ""
  263.     ELSE
  264.         IF INSTR(x$(i%), CHR$(10)) > 1 THEN EXIT FOR
  265.     END IF
  266.  
  267. gg% = 0
  268. FOR g% = 1 TO noe
  269.     IF INSTR(x$(g%), CHR$(4)) THEN gg% = g%: EXIT FOR
  270.  
  271. IF gg% > scr + row AND row + scr < noe AND row = page.h THEN
  272.     scr = scr + 1: GOSUB scrollscrn: row = row - 1: LOCATE margin.t + row, POS(0)
  273.  
  274. yy% = CSRLIN: xx% = POS(0)
  275.  
  276. IF row = 1 OR wrap.on% = 0 THEN q% = 0 ' Disable print line above.
  277.  
  278. k% = filled% + q% ' Number of altered lines to print to screen. If q% = 1 the line above the current row is also printed. Note that since the FOR loop starts at j% = 0, k% is actually one less than the number of lines altered in the wrap routine.
  279. IF row - q% + k% >= page.h THEN k% = page.h - (row - q%)
  280. IF scr + row - q% + k% > UBOUND(x$) THEN k% = UBOUND(x$) - (scr + row - q%)
  281.  
  282. IF noe - scr < page.h AND noe >= page.h THEN ' Adjust to bottom of the text screen.
  283.     scr = noe - page.h
  284.     IF noe - scr = page.h AND LEN(MID$(x$(noe), 1, INSTR(x$(noe), CHR$(10)) - 1)) >= dwidth OR noe - scr = page.h AND INSTR(x$(noe), CHR$(255)) THEN
  285.         scr = scr + 1 ' Raises everything up one line below bottom line to allow for the blank line occupied by the cursor at column 1.
  286.         IF POS(0) = margin.l + 1 AND row = page.h - 1 AND INSTR(x$(row + scr), CHR$(255)) THEN yy% = yy% + 1
  287.     ELSE
  288.         yy% = yy% + 1
  289.     END IF
  290.     row = 1: k% = page.h - 1: q% = 0
  291.  
  292. FOR j% = 0 TO k%
  293.     i% = row - q% + j% ' Display row.
  294.     LOCATE i% + margin.t, margin.l + 1
  295.     a1$ = SPACE$(dwidth + 1)
  296.     x$ = RTRIM$(MID$(x$(scr + i%), 1, INSTR(x$(scr + i%), CHR$(10)) - 1))
  297.     MID$(a1$, 1, LEN(MID$(x$(scr + i%), 1, dwidth))) = x$
  298.  
  299.     h% = INSTR(x$, CHR$(4))
  300.     IF h% THEN ' Re-establish cursor position.
  301.         yy% = CSRLIN: xx% = margin.l + border.thk + h%
  302.         MID$(a1$, h%, 1) = cur$ ' NOTE: h% can be longer than len(a1$) when # is a space at end of full line of text. When this happens, QB64 will simply not include it in the shaorter a1$.
  303.         MID$(x$(scr + i%), h%, 1) = cur$: cur$ = ""
  304.     END IF
  305.  
  306.     PRINT a1$;
  307.  
  308. q% = 0
  309. LOCATE yy%, xx%
  310.  
  311. row = CSRLIN - margin.t ' Needed here and in getkey for auto events.
  312.  
  313. '----------------------------------------------------------------------------------------------------------------------------
  314. REM BKSP CHR$(8) used at end of doc requires this routine to re-position cursor at the end of a wrapped upwards piece of text.
  315. IF cur$ = "eod" THEN
  316.     b$ = CHR$(0) + "u": GOSUB getkeyauto: cur$ = ""
  317. '----------------------------------------------------------------------------------------------------------------------------
  318.  
  319. IF curadvance% THEN
  320.     SELECT CASE curadvance%
  321.         CASE 1
  322.             b$ = CHR$(0) + ">"
  323.         CASE -1
  324.             ' Paragraph. variable is set to -1 for paragraphs.
  325.             b$ = CHR$(0) + "^"
  326.     END SELECT
  327.  
  328.     GOSUB getkeyauto ' Make sure this routine always exits getkeyauto so it can return here after advancing cursor. Remember, non character keys don't exit that loop unless b$ = "". There is a kloop% condition to meet this gosub/return requirement.
  329.  
  330.     curadvance% = 0
  331.  
  332. GOSUB makescrb
  333. RETURN ' ==================================================================
  334.  
  335. ' -------------------------------------------------------------------------
  336. '                             NESTED GOSUBS
  337. ' -------------------------------------------------------------------------
  338.  
  339. markercalc:
  340. IF hlbypass% = 0 THEN
  341.     o% = (row - 1) * dwidth2 + dwidth + 1
  342.     hlbypass% = 0
  343.  
  344. o1% = (o% - (o% MOD dwidth2)) / dwidth2 + 1 ' Relative (margin independent) cursor row origin.
  345. d% = (row - 1) * dwidth2 + col ' Relative (margin independent) cursor destination marker.
  346. o2% = o% MOD dwidth2 ' Relative (margin independent) cursor column origin.
  347. d1% = row ' Relative (margin independent) cursor row destination. Note: row is also relative (margin independent).
  348. d2% = col ' Relative (margin independent) cursor column destination. Note: col is also relative (margin independent).
  349.  
  350. scrollscrn: '
  351. yy% = CSRLIN: xx% = POS(0)
  352. scrmov = scr - oldscr
  353.  
  354. IF mark% AND markbypass% = 0 THEN
  355.     mark% = mark% - scrmov * dwidth2
  356.     markrow% = markrow% - scrmov
  357.     d% = (CSRLIN - margin.t - 1 - scrmov) * dwidth2 + POS(0) - margin.l
  358.     IF mhl1% THEN
  359.         mhl1% = mhl1% - scrmov * dwidth2
  360.         mhl1row% = mhl1row% - scrmov
  361.     END IF
  362.  
  363.     j% = d1% - scrmov
  364.     IF cutdrow% > scr AND cutdrow% <= page.h + scr THEN ' On screen
  365.         j% = cutdrow% - scr
  366.         d% = (j% - 1) * dwidth2 + cutdcol%
  367.     ELSE ' Off screen.
  368.         IF cutdrow% < scr THEN ' Above screen.
  369.             d% = 1
  370.             mhl1row% = 0
  371.         ELSE ' Below screen.
  372.             a1$ = MID$(x$(page.h + scr), 1, INSTR(x$(page.h + scr), CHR$(10)) - 1)
  373.             d% = (page.h - 1) * dwidth2 + LEN(a1$)
  374.             IF LEN(a1$) > dwidth THEN dmodify% = 1 ELSE d% = d% + 1
  375.         END IF
  376.     END IF
  377.     d1% = (d% - (d% MOD dwidth2)) / dwidth2 + 1
  378.     d2% = d% MOD dwidth2 ' Relative (margin independent) cursor column origin.
  379.     yy% = margin.t + d1%: xx% = margin.l + d2%
  380.     row = d1%: col = d2%
  381.     LOCATE yy%, xx%
  382.     j% = 0
  383.     IF cutmrow% THEN
  384.         SELECT CASE cutmrow%
  385.             CASE IS < cutdrow%: j% = cutmrow%: j1% = cutmcol%
  386.             CASE IS = cutdrow% ' Highlighting begins and ends on same row. Ex: Left and right arrow keys.
  387.                 IF cutmcol% < cutdcol% THEN j% = cutmrow%: j1% = cutmcol% ELSE j% = cutdrow%: j1% = cutdcol% ' Right arrow vs left arrow directions.
  388.             CASE IS > cutdrow%: j% = cutdrow%: j1% = cutdcol%
  389.         END SELECT
  390.  
  391.         jtop% = cutmrow%: jbot% = cutdrow%: IF jtop% > jbot% THEN SWAP jtop%, jbot%
  392.         IF h% < 0 THEN j% = -j% ' Preserve highlighted text while using scrollbar.
  393.     END IF
  394.     j% = 0 ' For all non-mark% (highlighted) text line printing.
  395.  
  396. FOR i% = 1 TO page.h
  397.     IF scr + i% > noe THEN EXIT FOR
  398.     LOCATE margin.t + i%, margin.l + 1
  399.     a1$ = SPACE$(dwidth + 1)
  400.     MID$(a1$, 1) = MID$(x$(scr + i%), 1, INSTR(x$(scr + i%), CHR$(10)) - 1)
  401.     a2$ = MID$(x$(scr + i%), 1, INSTR(x$(scr + i%), CHR$(10)) - 1)
  402.     a3$ = SPACE$(dwidth + 1 - LEN(a2$))
  403.     x1 = c1%: x2 = c2%: x3 = c1%: x4 = c2%: k% = LEN(a2$)
  404.  
  405.     SELECT CASE j%
  406.         CASE 0
  407.             PRINT a1$;
  408.         CASE IS < 0
  409.             IF i% + scr = jtop% THEN
  410.                 IF cutmrow% = cutdrow% THEN k% = ABS(cutmcol% - cutdcol%)
  411.                 x3 = h1%: x4 = h2%
  412.             ELSEIF i% + scr > jtop% AND i% + scr < jbot% THEN
  413.                 j1% = 1: x3 = h1%: x4 = h2%
  414.             ELSEIF i% + scr = jbot% THEN
  415.                 j1% = 1: x3 = h1%: x4 = h2%
  416.                 IF cutmrow% < cutdrow% THEN k% = col - 1 ELSE k% = cutmcol% - 1
  417.             END IF
  418.  
  419.             COLOR x1, x2: PRINT MID$(a2$, 1, j1% - 1);
  420.             COLOR x3, x4: PRINT MID$(a2$, j1%, k%);
  421.             COLOR c1%, c2%: PRINT MID$(a2$, j1% + k%) + a3$;
  422.         CASE ELSE
  423.             IF i% = h% THEN
  424.                 IF cutmrow% = cutdrow% THEN ' Left/Right Highlighting on origination row.
  425.                     x3 = h1%: x4 = h2%: k% = ABS(cutmcol% - cutdcol%)
  426.                 ELSE ' Left/Right/Up/Down Highlighting from row before scrolling row.
  427.                     x3 = h1%: x4 = h2%
  428.                     IF cutdrow% > cutmrow% THEN
  429.                         j1% = 1: k% = col - 1
  430.                     ELSE
  431.                         ' Do nothing. Arrow left and up do not require any change in parameters here.
  432.                     END IF
  433.                 END IF
  434.             ELSE
  435.                 IF i% + scr > jtop% AND i% + scr < jbot% THEN
  436.                     j1% = 1: x3 = h1%: x4 = h2%
  437.                 ELSE
  438.                     IF i% + scr = cutmrow% THEN
  439.                         x3 = h1%: x4 = h2%
  440.                         IF cutdrow% < cutmrow% THEN
  441.                             j1% = 1: k% = cutmcol% - 1
  442.                         ELSEIF cutdrow% = cutmrow% THEN
  443.                             k% = ABS(cutmcol% - cutdcol%)
  444.                         ELSEIF cutdrow% > cutmrow% THEN
  445.                             ' Do nothing.
  446.                         END IF
  447.                     ELSEIF i% + scr = cutdrow% THEN
  448.                         x3 = h1%: x4 = h2%
  449.                         IF cutdrow% > cutmrow% THEN
  450.                             j1% = 1: k% = cutdcol% - 1
  451.                         ELSE
  452.                             k% = ABS(LEN(a2$) - cutdcol%)
  453.                         END IF
  454.                     END IF
  455.                 END IF
  456.             END IF
  457.             COLOR x1, x2: PRINT MID$(a2$, 1, j1% - 1);
  458.             COLOR x3, x4: PRINT MID$(a2$, j1%, k%);
  459.             COLOR c1%, c2%: PRINT MID$(a2$, j1% + k%, LEN(a2$) - k%) + a3$;
  460.     END SELECT
  461. oldscr = scr
  462. COLOR c1%, c2%
  463. LOCATE yy%, xx%
  464.  
  465. GOSUB movescrollbox
  466.  
  467.  
  468. wipescrn:
  469. yy% = CSRLIN: xx% = POS(0)
  470. a1$ = SPACE$(dwidth + 1)
  471. FOR i% = 1 TO page.h
  472.     LOCATE i% + margin.t, margin.l + 1
  473.     PRINT a1$;
  474. LOCATE yy%, xx%
  475.  
  476. hlwipescrn:
  477. yy% = CSRLIN: xx% = POS(0)
  478. FOR j% = 1 TO page.h
  479.     IF j% + scr > noe THEN EXIT FOR
  480.     x$ = SPACE$(dwidth + 1)
  481.     a1$ = x$(j% + scr)
  482.     MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
  483.     LOCATE margin.t + j%, margin.l + 1
  484.     PRINT x$;
  485. GOSUB clearmarkers
  486. LOCATE yy%, xx%
  487.  
  488. clearmarkers:
  489. ' Clear most variables used in highlighting process. Some others are non-essential to conditions.
  490. mark% = 0: o% = 0: mhl% = 0: mhl1% = 0: mhl1col% = 0: mhl1row% = 0: mhlclear% = 0: cutdrow% = 0
  491. cutmrow% = 0: o1% = 0: o2% = 0: d% = 0: d1% = 0: d2% = 0: dmodify% = 0
  492. markrow% = 0: markcol% = 0: cutmcol% = 0: cutdcol% = 0
  493.  
  494. betatest:
  495. ss% = CSRLIN: ww% = POS(0)
  496. z$ = MID$(beta$, 1, INSTR(beta$, "|") - 1)
  497. beta$ = MID$(beta$, INSTR(beta$, "|") + 1)
  498. IF LEFT$(z$, 1) = CHR$(32) THEN
  499.     b$ = CHR$(0) + CHR$(VAL(MID$(z$, 2)))
  500.     b$ = CHR$(VAL(z$))
  501. IF LEN(beta$) THEN
  502.     LOCATE 24, 1: PRINT SPACE$(40);: LOCATE 24, 1
  503.     COLOR 1, 0
  504.     PRINT LEN(beta$) \ 2; VAL(z$);
  505.     IF LEFT$(z$, 1) = CHR$(32) THEN PRINT " 0"; CHR$(VAL(MID$(z$, 2)));
  506.     IF ASC(b$) > 31 THEN PRINT " b$ = "; b$;
  507.     LOCATE ss%, ww%
  508.     COLOR 7, 0
  509.  
  510. '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  511. '                          LARGEST GOSUB ROUTINE
  512. getkey:
  513.     _LIMIT 30
  514.     IF debug% THEN GOSUB debugger
  515.  
  516.     DEF SEG = 0 ' Look for Shift key press.
  517.     IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN shift% = -1 ELSE shift% = 0
  518.     IF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN ctrl% = -1 ELSE ctrl% = 0
  519.     IF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN ctrlshift% = -1 ELSE ctrlshift% = 0
  520.     DEF SEG
  521.  
  522.     ' Mouse clicks can influence b$ outside of the keypress loop. That's why b$ = "" in some keypress routines when they are completed.
  523.     IF autokey% = 0 THEN
  524.         b$ = INKEY$
  525.         IF LEN(b$) THEN
  526.             IF curhide% = -1 THEN
  527.                 GOSUB backtocursor
  528.             ELSE
  529.                 GOSUB getcurinfo
  530.             END IF
  531.             locked% = 0 ' A key press removes all mouse and mouse wheel locks.
  532.             IF ctrlshift% THEN IF b$ = CHR$(0) + "s" OR b$ = CHR$(0) + "t" THEN shift% = -1
  533.         END IF
  534.     ELSE
  535.         autokey% = 0
  536.         IF LEN(autokey$) THEN b$ = autokey$: autokey$ = ""
  537.     END IF
  538.  
  539.     IF LEN(beta$) THEN GOSUB betatest
  540.  
  541.     IF mhl% THEN
  542.         null$ = INKEY$: b$ = "" ' Clear key buffer when left mouse button is held down and lock out keys.
  543.     END IF
  544.  
  545.     IF mark% THEN
  546.         IF b$ >= CHR$(32) AND b$ <= CHR$(127) THEN
  547.             autokey% = -99: autokey$ = b$
  548.             b$ = CHR$(0) + "S"
  549.         END IF
  550.     END IF
  551.  
  552.     IF mark% AND b$ = CHR$(24) OR mark% AND b$ = CHR$(3) OR mark% AND b$ = CHR$(0) + "S" OR b$ = CHR$(1) OR b$ = CHR$(22) OR ctrlshift% AND b$ = CHR$(0) + "u" OR ctrlshift% AND b$ = CHR$(0) + "w" THEN ' Cut/Copy/Paste
  553.  
  554.         SELECT CASE b$
  555.             CASE CHR$(0) + "w" ' Ctrl + Shift + Home
  556.                 ' Required hold variables.
  557.                 hold1% = row: hold2% = scr: hold3% = POS(0) - margin.l
  558.  
  559.                 IF mark% THEN
  560.                     markbypass% = -1: GOSUB getkeyauto: markbypass% = 0
  561.  
  562.                     IF cutmrow% < cutdrow% THEN
  563.                         j% = cutmrow% - scr: k% = cutdrow% - scr: IF k% > page.h THEN k% = page.h
  564.                         FOR i% = j% TO k%
  565.                             x$ = SPACE$(dwidth + 1)
  566.                             a1$ = x$(i% + scr)
  567.                             MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
  568.                             LOCATE margin.t + i%, margin.l + 1
  569.                             PRINT x$;
  570.                         NEXT
  571.                         mark% = (cutmrow% - 1) * dwidth2 + cutmcol% - 1 ' Note the -1 is here to "flip" to the other side of the highlighted line and not overlap.
  572.                         markrow% = (mark% - (mark% MOD dwidth2)) / dwidth2 + 1
  573.                         markcol% = mark% MOD dwidth2
  574.                     ELSE
  575.                         mark% = (cutmrow% - 1) * dwidth2 + cutmcol%
  576.                         markrow% = cutmrow%: markcol% = cutmcol% - 1 ' - 1 required to avoid overlap.
  577.                     END IF
  578.  
  579.                     IF mark% = 0 THEN ' Shift + Ctrl + Home resulted in clearing all text when all text was previously highlighted. Ex: Shift + Ctrl + A followed by Shift + Ctrl + HOme.
  580.                         GOSUB clearmarkers
  581.                     ELSE
  582.                         cutdrow% = 1: cutdcol% = 1
  583.                     END IF
  584.  
  585.                     col = 1 ' Required.
  586.                     b$ = ""
  587.                 ELSE
  588.                     GOSUB wipescrn
  589.                     GOSUB clearmarkers
  590.                     mark% = (hold1% + hold2% - 1) * dwidth2 + hold3%: markrow% = hold1% + hold2%: markcol% = hold3%
  591.                     cutmrow% = hold1% + hold2%: cutmcol% = markcol%
  592.                     cutdrow% = 1: cutdcol% = 1: col = 1
  593.                 END IF
  594.  
  595.                 row = 1: scr = 0: LOCATE margin.t + row, margin.l + 1
  596.  
  597.                 GOSUB markercalc
  598.  
  599.                 j% = page.h: k% = 1: g% = 0: IF j% >= cutmrow% THEN j% = cutmrow%: g% = 1
  600.                 COLOR h1%, h2%
  601.                 FOR i% = 0 TO j% - 1 - g%
  602.                     LOCATE margin.t + 1 + i%, margin.l + 1
  603.                     PRINT MID$(x$(k% + i%), 1, INSTR(x$(k% + i%), CHR$(10)) - 1);
  604.                 NEXT
  605.                 IF g% THEN
  606.                     LOCATE margin.t + 1 + i%, margin.l + 1
  607.                     PRINT MID$(x$(k% + i%), 1, markcol%);
  608.                     COLOR c1%, c2%
  609.                     PRINT MID$(x$(k% + i%), markcol% + 1);
  610.                 END IF
  611.                 COLOR c1%, c2%
  612.                 LOCATE margin.t + 1, margin.l + 1
  613.                 b$ = ""
  614.             CASE CHR$(0) + "u" ' Ctrl + Shift + End
  615.                 hold1% = row: hold2% = scr: hold3% = POS(0) - margin.l
  616.                 holdcutmrow% = cutmrow%: holdcutmcol% = cutmcol%: holdcutdrow% = cutdrow%: holdcutdcol% = cutdcol%
  617.  
  618.                 IF mark% THEN
  619.                     markbypass% = -1: GOSUB getkeyauto: markbypass% = 0
  620.  
  621.                     IF cutmrow% > cutdrow% THEN ' Highlighting was from bottom up.
  622.                         hold1% = cutmrow% - scr: hold2% = scr: hold3% = cutmcol%
  623.                     ELSE ' Highlighting continuing from top down.
  624.                         mark% = (cutmrow% - 1) * dwidth2 + cutmcol%
  625.                         markrow% = cutmrow%
  626.                         cutdrow% = row + scr: cutdcol% = POS(0) - margin.l
  627.                         hold1% = cutmrow% - hold2% ' orig scr. hold1% is now row.
  628.                         hold3% = cutmcol%
  629.                     END IF
  630.                 ELSE
  631.                     GOSUB clearmarkers: GOSUB getkeyauto
  632.                     mark% = (hold1% + hold2% - 1) * dwidth2 + hold3%: markrow% = hold1% + hold2%: markcol% = hold3%
  633.                     cutmrow% = hold1% + hold2%: cutmcol% = markcol%
  634.                     cutdrow% = noe: cutdcol% = LEN(MID$(x$(noe), 1, INSTR(x$(noe), CHR$(10)) - 1)) + 1
  635.                 END IF
  636.  
  637.                 yy% = CSRLIN: xx% = POS(0): col = xx% - margin.l
  638.  
  639.                 GOSUB markercalc
  640.  
  641.                 COLOR h1%, h2%
  642.  
  643.                 IF noe - cutmrow% < page.h THEN
  644.                     j% = page.h - (cutmrow% - scr)
  645.                     k% = cutmrow% - scr
  646.                 ELSE
  647.                     j% = page.h - 1: k% = 1: hold1% = 1: hold2% = scr: hold3% = 1
  648.                 END IF
  649.  
  650.                 IF noe < page.h THEN j% = noe - hold1%
  651.                 LOCATE margin.t + k%, margin.l + hold3%
  652.                 a1$ = MID$(x$(hold1% + hold2%), 1, INSTR(x$(hold1% + hold2%), CHR$(10)) - 1)
  653.                 PRINT MID$(a1$, hold3%);
  654.                 FOR i% = 1 TO j%
  655.                     LOCATE margin.t + k% + i%, margin.l + 1
  656.                     PRINT MID$(x$(hold1% + hold2% + i%), 1, INSTR(x$(hold1% + hold2% + i%), CHR$(10)) - 1);
  657.                 NEXT
  658.                 COLOR c1%, c2%
  659.                 LOCATE yy%, xx%
  660.  
  661.                 IF mark% <> 0 AND hold1% = row AND cutmrow% = holdcutmrow% AND cutmcol% = holdcutmcol% AND cutdrow% = holdcutdrow% AND cutdcol% = holdcutdcol% THEN
  662.                     GOSUB clearmarkers
  663.                 END IF
  664.  
  665.                 b$ = ""
  666.             CASE CHR$(1)
  667.                 GOSUB clearmarkers
  668.                 b$ = CHR$(0) + "u"
  669.                 GOSUB getkeyauto
  670.                 yy% = CSRLIN: xx% = POS(0)
  671.                 mark% = dwidth2 * -scr + 1: markrow% = -scr + 1: markcol% = 1
  672.                 cutmrow% = 1: cutmcol% = 1
  673.                 cutdrow% = noe: cutdcol% = LEN(MID$(x$(noe), 1, INSTR(x$(noe), CHR$(10)) - 1)) + 1
  674.                 col = xx% - margin.l
  675.  
  676.                 GOSUB markercalc
  677.  
  678.                 LOCATE margin.t + 1, margin.l + 1
  679.                 j% = page.h: k% = scr + 1
  680.                 IF noe < page.h THEN j% = noe
  681.                 COLOR h1%, h2%
  682.                 FOR i% = 0 TO j% - 1
  683.                     LOCATE margin.t + 1 + i%, margin.l + 1
  684.                     PRINT MID$(x$(k% + i%), 1, INSTR(x$(k% + i%), CHR$(10)) - 1);
  685.                 NEXT
  686.                 COLOR c1%, c2%
  687.                 LOCATE yy%, xx%
  688.                 b$ = ""
  689.             CASE CHR$(0) + "S", CHR$(24) ' Del and Cut Ctrl + X
  690.                 IF b$ = CHR$(24) THEN GOSUB copytext
  691.                 IF cutmrow% = cutdrow% THEN ' Same line delete.
  692.                     GOSUB singlelinedelete
  693.                     updatescrn% = 1
  694.                     b$ = "exit": EXIT DO
  695.                 ELSE ' Multiple line delete.
  696.                     GOSUB multilinedelete
  697.                     b$ = ""
  698.                 END IF
  699.             CASE CHR$(3) ' Copy Ctrl + C
  700.                 GOSUB copytext
  701.                 b$ = "exit": EXIT DO
  702.             CASE CHR$(22) ' Paste Ctrl + V
  703.                 ' NOTE: col is not defined in these wp routines but is when scrollscrn is called.
  704.                 GOSUB clipboardconvert
  705.                 IF row = 1 AND scr > 0 THEN
  706.                     scr = scr - 1: h% = 0: GOSUB scrollscrn: row = row + 1
  707.                     LOCATE margin.t + row, margin.l + col
  708.                 ELSEIF row = page.h AND scr + page.h < noe THEN
  709.                     scr = scr + 1: h% = 0: GOSUB scrollscrn: row = row - 1
  710.                     LOCATE margin.t + row, margin.l + col
  711.                 END IF
  712.  
  713.                 IF mark% THEN
  714.                     i1% = cutmrow%: j1% = cutmcol%
  715.                     i2% = cutdrow%: j2% = cutdcol%
  716.                     IF cutdrow% < cutmrow% OR cutdrow% = cutmrow% AND cutdcol% < cutmcol% THEN SWAP i1%, i2%: SWAP j1%, j2%
  717.                 ELSE
  718.                     i1% = row + scr: j1% = POS(0) - margin.l
  719.                     i2% = row + scr: j2% = POS(0) - margin.l
  720.                 END IF
  721.                 a1$ = MID$(x$(i1%), 1, INSTR(x$(i1%), CHR$(10)) - 1)
  722.                 a2$ = MID$(a1$, 1, j1% - 1)
  723.                 a1$ = MID$(x$(i2%), 1, INSTR(x$(i2%), CHR$(10)) - 1)
  724.                 a3$ = MID$(a1$, j2%)
  725.                 IF a3$ = "" THEN
  726.                     cur$ = "eod"
  727.                 ELSE
  728.                     cur$ = LEFT$(a3$, 1): MID$(a3$, 1, 1) = CHR$(4)
  729.                 END IF
  730.                 IF row > 1 THEN
  731.                     row = row - 1
  732.                     a1$ = MID$(x$(i1% - 1), 1, INSTR(x$(i1% - 1), CHR$(10)) - 1)
  733.                     a$ = a1$ + a2$ + myCLIPBOARD$ + a3$
  734.                 ELSE
  735.                     a$ = a2$ + myCLIPBOARD$ + a3$
  736.                 END IF
  737.  
  738.                 IF mark% THEN
  739.                     FOR i% = i1% TO i2%
  740.                         x$(i%) = ""
  741.                     NEXT
  742.                 ELSE
  743.                     x$(i1%) = ""
  744.                 END IF
  745.  
  746.                 wrap.on% = -1: GOSUB wrapper
  747.  
  748.                 IF cur$ = "eod" THEN
  749.                     scr = noe - page.h
  750.                     IF scr < 0 THEN scr = 0
  751.                     row = 1
  752.                 ELSE
  753.                     FOR i% = 1 TO noe
  754.                         IF INSTR(x$(i%), CHR$(4)) THEN
  755.                             scr = i% - page.h + 1
  756.                             IF scr < 0 THEN scr = 0
  757.                             row = 1
  758.                             EXIT FOR
  759.                         END IF
  760.                     NEXT
  761.                 END IF
  762.  
  763.                 LOCATE row + margin.t, margin.l + 1
  764.                 filled% = page.h: GOSUB displaydoc
  765.                 GOSUB movescrollbox
  766.                 b$ = ""
  767.         END SELECT
  768.     END IF
  769.  
  770.     IF LEN(b$) OR mhl% THEN
  771.         IF mhl% OR shift% AND INSTR("KMHPOGIQts", MID$(b$, 2, 1)) AND LEN(b$) = 2 THEN
  772.             ' Left mouse button down or Shift key down with a highlighting key pressed.
  773.             IF mark% = 0 THEN
  774.                 col = POS(0) - margin.l
  775.                 mark% = (row - 1) * dwidth2 + col: markrow% = row: markcol% = col ' Highlight cursor position markers.
  776.                 IF cutmrow% = 0 THEN cutmrow% = markrow% + scr: cutmcol% = markcol% ' Marks the entry row and column position for all the cummulative highlighted text and allows this text to be preserved when scrolling.
  777.             END IF
  778.         ELSE
  779.             ' Disable highlight key when active and a key is pressed without Shift key held or
  780.             IF ctrlshift% OR ctrl% AND INSTR("tsuw", MID$(b$, 2, 1)) = 0 THEN
  781.                 b$ = ""
  782.             ELSE
  783.                 IF mark% AND LEN(b$) > 0 THEN ' Highlighted text and key press. Note: Left mouse click to clear text is in another routine.
  784.                     IF b$ <> CHR$(3) AND b$ <> CHR$(22) AND b$ <> CHR$(24) THEN GOSUB hlwipescrn ' Use this or some other routine to clear the highlighted text off the screen.
  785.                 END IF
  786.             END IF
  787.         END IF
  788.  
  789.         IF mhl% AND locked% <> 2 THEN ' Left mouse button click or held highlighting.
  790.             IF my% = CSRLIN THEN
  791.                 ' Lateral movement. Do nothing. Action is taken in the select case mov routine.
  792.             ELSE ' Simulate an up or down arrow key routines for mouse highlighting when changing rows.
  793.                 IF my% < CSRLIN THEN b$ = CHR$(0) + "H" ' Highlight upwards.
  794.                 IF my% > CSRLIN THEN b$ = CHR$(0) + "P" ' Highlight downwards.
  795.             END IF
  796.         END IF
  797.  
  798.         IF keylogger% THEN
  799.             SELECT CASE LEN(b$)
  800.                 CASE 1
  801.                     z$ = LTRIM$(STR$(ASC(b$))) + "|"
  802.                 CASE 2
  803.                     z$ = " " + LTRIM$(STR$(ASC(MID$(b$, 2, 1)))) + "|"
  804.             END SELECT
  805.             keylogger$ = keylogger$ + z$: z$ = ""
  806.         END IF
  807.  
  808.         IF LEN(b$) = 1 OR b$ = CHR$(0) + "S" THEN
  809.             IF row = 1 AND scr > 0 THEN ' Scroll screen down so cursor is on row 2 instead of 1.
  810.                 scr = scr - 1: GOSUB scrollscrn: row = row + 1: LOCATE margin.t + row, POS(0)
  811.             END IF
  812.  
  813.             IF row = page.h AND row + scr < noe THEN ' Scroll screen up so cursor is on row above last row.
  814.                 scr = scr + 1: GOSUB scrollscrn: row = row - 1: LOCATE margin.t + row, POS(0)
  815.             END IF
  816.         END IF
  817.  
  818.         getkeyauto:
  819.         row = CSRLIN - margin.t ' Needed here for auto cursor up / down changes. Also needed at display routine where wrap can make row changes if a word above is wrapped down when backspacing.
  820.         kloop% = 0
  821.         DO
  822.             ' Determine cursor boundaries at end of a text line. --------------
  823.             a$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  824.             IF INSTR(a$, CHR$(255)) THEN ' Special to paragraph.
  825.                 IF INSTR(MID$(a$, 2), CHR$(255)) THEN
  826.                     n% = LEN(a$)
  827.                 END IF
  828.                 IF a$ = CHR$(255) THEN n% = 1
  829.             ELSEIF LEN(a$) > dwidth THEN ' Space in right margin.
  830.                 n% = dwidth + ovm%
  831.             ELSE ' All within margin length situations.
  832.                 IF row + scr < noe THEN ' Rows above last line.
  833.                     n% = LEN(a$)
  834.                 ELSE 'Last line.
  835.                     n% = LEN(a$) + 1
  836.                 END IF
  837.             END IF
  838.  
  839.             n% = n% + margin.l
  840.  
  841.             ' --------------------------------------------------------------------
  842.  
  843.             IF autobkspdel% THEN
  844.                 IF kloop% = LEN(b$) THEN
  845.                     b$ = b$ + CHR$(0) + "S"
  846.                     autobkspdel% = 0
  847.                 END IF
  848.             ELSEIF autodelforward% THEN
  849.                 IF kloop% = LEN(b$) THEN
  850.                     b$ = b$ + CHR$(0) + "S"
  851.                     autodelforward% = 0
  852.                 END IF
  853.             END IF
  854.  
  855.             DO
  856.                 DO
  857.                     reloop% = 0
  858.  
  859.                     IF mhl% AND locked% <> 2 THEN ' Left mouse key highlighting.
  860.  
  861.                         IF row = mhl1row% THEN ' Detect when the row in the loop matches the row marked to terminate the loop.
  862.                             SELECT CASE mhl1col% ' Now that the loop has terminated at the marked row, find the marked column.
  863.                                 CASE 999 ' Column at loop exit is already at the marked column.
  864.                                     mhl% = 0: EXIT DO
  865.                                 CASE ELSE ' Set col variable to mouse column marker and zero out that marker along with the simulated key press.
  866.                                     ' New col position allows highlighter routine to highlight text on this row to this column.
  867.                                     col = mhl1col%: LOCATE , margin.l + col
  868.                                     mhl1col% = 999 ' 0
  869.                                     b$ = CHR$(0) + CHR$(0): kloop% = 0 ' Important. Must nullify variable to avoid case selection below.
  870.                             END SELECT
  871.                         END IF
  872.                     END IF
  873.  
  874.                     IF mark% AND markbypass% = 0 THEN
  875.                         a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  876.                         SELECT CASE MID$(b$, 2, 1) ' Cursor movement routine. May be replace or incorporated into outer cursor movement routines.
  877.                             CASE "I"
  878.                                 IF shift% THEN
  879.                                     IF scr > 0 THEN
  880.                                         k% = page.h - 1 ' The number of lines scrolled up. Ex: in a 9-line doc, scroll up 16 lines.
  881.                                         IF k% > scr THEN k% = scr
  882.                                         cutdrow% = row + scr - k%: cutdcol% = 1 ' No need for a reverse condition. Page Up treats them the same. For ref cutmrow% > cutdrow% is forward.
  883.                                         scr = scr - k%
  884.                                         LOCATE margin.t + 1, margin.l + 1
  885.                                         FOR i% = 1 TO page.h
  886.                                             x$ = SPACE$(dwidth + 1)
  887.                                             a1$ = x$(i% + scr)
  888.                                             MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
  889.                                             LOCATE margin.t + i%, margin.l + 1
  890.                                             PRINT x$;
  891.                                         NEXT
  892.                                         LOCATE margin.t + row, margin.l + 1
  893.                                         GOSUB movescrollbox
  894.                                     ELSE
  895.                                         b$ = ""
  896.                                     END IF
  897.                                 END IF
  898.                             CASE "Q"
  899.                                 IF shift% THEN
  900.                                     IF noe > page.h THEN
  901.                                         k% = (page.h - 1) * 2 ' The number of lines scrolled down. Ex: in a 9-line doc, scroll down 16 lines.
  902.                                         IF k% + scr > noe THEN k% = noe - scr - 1
  903.  
  904.                                         IF cutmrow% < cutdrow% OR cutdrow% = 0 THEN
  905.                                             cutdrow% = row + scr + k% - page.h: cutdcol% = LEN(MID$(x$(row + scr + k% - page.h), 1, INSTR(x$(row + scr + k% - page.h), CHR$(10)) - 1))
  906.                                         ELSE ' Reverse on previously highlighted text.
  907.                                             cutdrow% = row + scr + k% - page.h + 1: cutdcol% = 1
  908.                                         END IF
  909.  
  910.                                         scr = scr + k% - page.h + 1
  911.                                         LOCATE margin.t + 1, margin.l + 1
  912.  
  913.                                         FOR i% = 1 TO page.h
  914.                                             x$ = SPACE$(dwidth + 1)
  915.                                             a1$ = x$(i% + scr)
  916.                                             MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
  917.                                             LOCATE margin.t + i%, margin.l + 1
  918.                                             PRINT x$;
  919.                                         NEXT
  920.  
  921.                                         hold1% = row: row = CSRLIN - margin.t
  922.                                         GOSUB movescrollbox
  923.                                         LOCATE margin.t + row, margin.l + 1
  924.                                         row = hold1%: col = 1
  925.                                     ELSE ' Doc too small to page down.
  926.                                         b$ = ""
  927.                                     END IF
  928.                                 END IF
  929.                             CASE "H"
  930.                                 IF row > 1 THEN
  931.                                     row = row - 1
  932.                                 ELSE
  933.                                     IF scr > 0 THEN
  934.                                         row = row + 1: scr = scr - 1
  935.                                         h% = 2: GOSUB scrollscrn
  936.                                         row = 1
  937.                                     END IF
  938.                                 END IF
  939.                             CASE "P"
  940.                                 IF row < page.h THEN
  941.                                     IF row + scr < noe THEN row = row + 1
  942.                                 ELSE
  943.                                     IF row + scr < noe% THEN
  944.                                         row = row - 1: scr = scr + 1
  945.                                         h% = page.h - 1: GOSUB scrollscrn
  946.                                         row = page.h
  947.                                     END IF
  948.                                 END IF
  949.                             CASE "M"
  950.                                 IF col < LEN(a1$) OR col = LEN(a1$) AND LEN(a1$) < dwidth + 1 AND row + scr = noe% THEN
  951.                                     col = col + 1
  952.                                 ELSE
  953.                                     IF row < page.h THEN
  954.                                         IF row + scr < noe THEN row = row + 1: col = 1
  955.                                     ELSE
  956.                                         IF row + scr < noe% THEN
  957.                                             row = row - 1: scr = scr + 1
  958.                                             h% = page.h - 1: GOSUB scrollscrn
  959.                                             row = page.h: col = 1
  960.                                             LOCATE margin.t + row, margin.l + col
  961.                                         END IF
  962.                                     END IF
  963.                                 END IF
  964.                             CASE "K"
  965.                                 IF col > 1 THEN
  966.                                     col = col - 1
  967.                                 ELSE
  968.                                     IF row > 1 THEN
  969.                                         row = row - 1
  970.                                         a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  971.                                         col = LEN(a1$): IF col < dwidth - 1 THEN col = col + 1
  972.                                         IF LEFT$(a1$, 1) = CHR$(255) THEN col = 1
  973.                                     ELSE
  974.                                         IF scr > 0 THEN
  975.                                             row = row + 1: scr = scr - 1
  976.                                             h% = 2: GOSUB scrollscrn
  977.                                             row = 1: a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  978.                                             col = LEN(a1$): IF col < dwidth - 1 THEN col = col + 1
  979.                                             IF LEFT$(a1$, 1) = CHR$(255) THEN col = 1
  980.                                         END IF
  981.                                     END IF
  982.                                 END IF
  983.                             CASE "G"
  984.                                 col = 1
  985.                             CASE "O"
  986.                                 col = LEN(a1$): IF col < dwidth - 1 THEN col = col + 1
  987.                                 IF LEFT$(a1$, 1) = CHR$(255) THEN col = 1
  988.                             CASE "s" ' Arrow left.
  989.                                 c_s_travel% = 0: c_s_tracker% = 0
  990.                                 k% = POS(0) - margin.l
  991.                                 a1$ = MID$(x$(row + scr), k%, 1)
  992.                                 IF a1$ = CHR$(32) THEN
  993.                                     g% = -1 'find the first space after any solid character.
  994.                                 ELSE
  995.                                     IF MID$(x$(row + scr), k% - 1, 1) = CHR$(32) OR k% = 1 THEN
  996.                                         g% = 2
  997.                                     ELSE
  998.                                         g% = 1
  999.                                     END IF
  1000.                                 END IF
  1001.                                 FOR i% = row + scr TO 1 STEP -1
  1002.                                     a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
  1003.                                     FOR j% = k% TO 1 STEP -1
  1004.                                         SELECT CASE g%
  1005.                                             CASE -1
  1006.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
  1007.                                                     k% = -1: EXIT FOR
  1008.                                                 END IF
  1009.  
  1010.                                                 IF MID$(a1$, j%, 1) <> CHR$(32) THEN
  1011.                                                     c_s_tracker% = c_s_tracker% + 1
  1012.                                                 ELSE
  1013.                                                     IF c_s_tracker% THEN k% = -1: EXIT FOR
  1014.                                                 END IF
  1015.                                             CASE 1
  1016.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
  1017.                                                     k% = -1: EXIT FOR
  1018.                                                 END IF
  1019.  
  1020.                                                 IF MID$(a1$, j%, 1) = CHR$(32) THEN
  1021.                                                     k% = -1: EXIT FOR
  1022.                                                 END IF
  1023.                                             CASE 2
  1024.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
  1025.                                                     k% = -1: EXIT FOR
  1026.                                                 ELSE
  1027.                                                     IF MID$(a1$, j%, 1) = CHR$(32) THEN
  1028.                                                         IF c_s_tracker% THEN k% = -1: EXIT FOR
  1029.                                                     ELSE
  1030.                                                         IF c_s_travel% THEN c_s_tracker% = c_s_tracker% + 1
  1031.                                                     END IF
  1032.                                                 END IF
  1033.                                         END SELECT
  1034.                                         c_s_travel% = c_s_travel% + 1
  1035.                                     NEXT j%
  1036.                                     IF k% = -1 THEN EXIT FOR
  1037.                                     k% = LEN(MID$(x$(i% - 1), 1, INSTR(x$(i% - 1), CHR$(10)) - 1))
  1038.                                 NEXT i%
  1039.  
  1040.                                 col = POS(0) - margin.l: a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  1041.                                 FOR c_s_index% = 1 TO c_s_travel% - 1
  1042.                                     IF col > 1 THEN
  1043.                                         col = col - 1
  1044.                                     ELSE
  1045.                                         IF row > 1 THEN
  1046.                                             row = row - 1
  1047.                                             a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  1048.                                             col = LEN(a1$)
  1049.                                         ELSE
  1050.                                             IF scr > 0 THEN
  1051.                                                 row = row + 1: scr = scr - 1
  1052.                                                 h% = 2: GOSUB scrollscrn
  1053.                                                 row = 1
  1054.                                                 a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  1055.                                                 col = LEN(a1$)
  1056.                                             END IF
  1057.                                         END IF
  1058.                                     END IF
  1059.  
  1060.                                     LOCATE margin.t + row, margin.l + col
  1061.  
  1062.                                     GOSUB highlighter
  1063.                                 NEXT
  1064.                                 b$ = "": EXIT DO
  1065.                             CASE "t"
  1066.                                 c_s_travel% = 0: c_s_tracker% = 0
  1067.                                 k% = POS(0) - margin.l
  1068.                                 a1$ = MID$(x$(row + scr), k%, 1)
  1069.                                 IF a1$ = CHR$(32) THEN g% = -1 ELSE g% = 1
  1070.                                 FOR i% = row + scr TO noe
  1071.                                     a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
  1072.                                     FOR j% = k% TO LEN(a1$)
  1073.                                         SELECT CASE g%
  1074.                                             CASE -1
  1075.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
  1076.                                                     k% = -1: EXIT FOR
  1077.                                                 END IF
  1078.                                                 IF MID$(a1$, j%, 1) <> CHR$(32) THEN
  1079.                                                     k% = -1: EXIT FOR
  1080.                                                 ELSE
  1081.                                                     c_s_tracker% = c_s_tracker% + 1
  1082.                                                 END IF
  1083.                                             CASE 1
  1084.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
  1085.                                                     k% = -1: EXIT FOR
  1086.                                                 END IF
  1087.  
  1088.                                                 IF MID$(a1$, j%, 1) = CHR$(32) THEN
  1089.                                                     c_s_tracker% = c_s_tracker% + 1
  1090.                                                 ELSE
  1091.                                                     IF c_s_tracker% THEN k% = -1: EXIT FOR
  1092.                                                 END IF
  1093.                                         END SELECT
  1094.                                         c_s_travel% = c_s_travel% + 1
  1095.                                     NEXT j%
  1096.                                     IF k% = -1 THEN EXIT FOR
  1097.                                     k% = 1
  1098.                                 NEXT i%
  1099.  
  1100.                                 FOR c_s_index% = 1 TO c_s_travel%
  1101.                                     col = POS(0) - margin.l: a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  1102.  
  1103.                                     IF col < LEN(a1$) OR col = LEN(a1$) AND LEN(a1$) < dwidth + 1 AND row + scr = noe% THEN
  1104.                                         col = col + 1
  1105.                                     ELSE
  1106.                                         IF row < page.h THEN
  1107.                                             row = row + 1: col = 1
  1108.                                         ELSE
  1109.                                             IF row + scr < noe% THEN
  1110.                                                 row = row - 1: scr = scr + 1
  1111.                                                 h% = page.h - 1: GOSUB scrollscrn
  1112.                                                 row = page.h: col = 1
  1113.                                                 LOCATE margin.t + row, margin.l + col
  1114.                                             END IF
  1115.                                         END IF
  1116.                                     END IF
  1117.                                     LOCATE margin.t + row, margin.l + col
  1118.                                     IF mark% THEN GOSUB highlighter '  Cursor may need to advance after mark% is zeroed in highlighter routine.
  1119.                                 NEXT
  1120.                                 b$ = "": EXIT DO
  1121.                         END SELECT
  1122.  
  1123.                         LOCATE margin.t + row, margin.l + col ' Note: Both row and col variables are relative and must be added to any left or top margin variables to appear in the proper row and column positions on the screen.
  1124.  
  1125.                         IF b$ <> CHR$(0) + "I" AND b$ <> CHR$(0) + "Q" THEN
  1126.                             GOSUB highlighter
  1127.                         ELSE
  1128.                             hold1% = row: GOSUB markercalc: h% = 0: GOSUB scrollscrn
  1129.                             row = hold1%: col = 1
  1130.                             LOCATE margin.t + row, margin.l + col
  1131.                             GOSUB markercalc
  1132.                             GOSUB movescrollbox ' Required. Scrollscrn polls this but the cursor gets repositioned, after that call, in line above.
  1133.                         END IF
  1134.  
  1135.                         a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  1136.  
  1137.                         IF col > LEN(a1$) THEN
  1138.                             col = LEN(a1$)
  1139.                             IF col < dwidth - 1 THEN col = col + 1
  1140.                             LOCATE margin.t + row, margin.l + col ' Note: Both row and col variables are relative and must be added to any left or top margin variables to appear in the proper row and column positions on the screen.
  1141.                         END IF
  1142.  
  1143.                         IF b$ = CHR$(0) + CHR$(0) OR mhl% = 0 THEN b$ = "exit-partial": EXIT DO ELSE reloop% = 1 ' Otherwise it loops.
  1144.  
  1145.                     ELSE
  1146.  
  1147.                         SELECT CASE MID$(b$, kloop% + 1, 2)
  1148.                             CASE CHR$(13) ' Paragraph.
  1149.                                 updatescrn% = 1
  1150.                                 k% = POS(0) - (margin.l + border.thk)
  1151.                                 IF k% > dwidth THEN
  1152.                                     ' There is a space in the margin, so leave that space and push the paragraph symbol to the line below.
  1153.                                     a$ = MID$(a$, 1, k%) + CHR$(255) + MID$(a$, k% + 1)
  1154.                                 ELSE
  1155.                                     a$ = MID$(a$, 1, k% - 1) + CHR$(255) + MID$(a$, k%)
  1156.                                 END IF
  1157.  
  1158.                                 ' wrapper is engaged by text line instr() analysis, later.
  1159.                                 curadvance% = -1
  1160.                                 noe = noe + 1: REDIM _PRESERVE x$(noe + 1)
  1161.                                 b$ = "exit"
  1162.                                 EXIT DO
  1163.                             CASE CHR$(0) + "H"
  1164.                                 IF row > 1 THEN
  1165.                                     row = row - 1
  1166.                                     LOCATE margin.t + row, POS(0)
  1167.                                     IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
  1168.                                         IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
  1169.                                     END IF
  1170.                                 ELSEIF scr > 0 THEN
  1171.                                     scr = scr - 1: h% = 0: GOSUB scrollscrn
  1172.                                     IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
  1173.                                         IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
  1174.                                     END IF
  1175.                                 END IF
  1176.                             CASE CHR$(0) + "P"
  1177.                                 IF row < page.h AND row + scr < noe THEN
  1178.                                     row = row + 1
  1179.                                     LOCATE margin.t + row, POS(0)
  1180.                                     IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
  1181.                                         IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
  1182.                                     END IF
  1183.                                 ELSEIF row + scr < noe THEN
  1184.                                     scr = scr + 1
  1185.                                     h% = 0: GOSUB scrollscrn
  1186.                                     IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
  1187.                                         IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
  1188.                                     END IF
  1189.                                 ELSEIF row + scr = noe AND LEN(a$) > dwidth OR row + scr = noe AND INSTR(a$, CHR$(255)) THEN ' On last filled text line.
  1190.                                     IF noe = UBOUND(x$) OR row = page.h THEN
  1191.                                         noe = noe + 1
  1192.                                         REDIM _PRESERVE x$(noe)
  1193.                                         scr = scr + 1: h% = 0: GOSUB scrollscrn
  1194.                                     ELSE
  1195.                                         row = row + 1
  1196.                                         GOSUB movescrollbox
  1197.                                     END IF
  1198.                                     LOCATE margin.t + row, margin.l + 1
  1199.                                 END IF
  1200.                             CASE CHR$(0) + "s" ' Arrow left.
  1201.                                 c_s_travel% = 0: c_s_tracker% = 0
  1202.                                 k% = POS(0) - margin.l
  1203.                                 a1$ = MID$(x$(row + scr), k%, 1)
  1204.                                 IF a1$ = CHR$(32) THEN
  1205.                                     g% = -1 'find the first space after any solid character.
  1206.                                 ELSE
  1207.                                     IF MID$(x$(row + scr), k% - 1, 1) = CHR$(32) OR k% = 1 THEN
  1208.                                         g% = 2
  1209.                                     ELSE
  1210.                                         g% = 1
  1211.                                     END IF
  1212.                                 END IF
  1213.                                 FOR i% = row + scr TO 1 STEP -1
  1214.                                     a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
  1215.                                     FOR j% = k% TO 1 STEP -1
  1216.                                         SELECT CASE g%
  1217.                                             CASE -1
  1218.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
  1219.                                                     k% = -1: EXIT FOR
  1220.                                                 ELSE
  1221.                                                     IF MID$(a1$, j%, 1) <> CHR$(32) THEN
  1222.                                                         c_s_tracker% = c_s_tracker% + 1
  1223.                                                     ELSE
  1224.                                                         IF c_s_tracker% THEN k% = -1: EXIT FOR
  1225.                                                     END IF
  1226.                                                 END IF
  1227.                                             CASE 1
  1228.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
  1229.                                                     k% = -1: EXIT FOR
  1230.                                                 ELSE
  1231.                                                     IF MID$(a1$, j%, 1) = CHR$(32) THEN
  1232.                                                         k% = -1: EXIT FOR
  1233.                                                     END IF
  1234.                                                 END IF
  1235.                                             CASE 2
  1236.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
  1237.                                                     k% = -1: EXIT FOR
  1238.                                                 ELSE
  1239.                                                     IF MID$(a1$, j%, 1) = CHR$(32) THEN
  1240.                                                         IF c_s_tracker% THEN k% = -1: EXIT FOR
  1241.                                                     ELSE
  1242.                                                         IF c_s_travel% THEN c_s_tracker% = c_s_tracker% + 1
  1243.                                                     END IF
  1244.                                                 END IF
  1245.                                         END SELECT
  1246.                                         c_s_travel% = c_s_travel% + 1
  1247.                                     NEXT j%
  1248.                                     IF k% = -1 THEN EXIT FOR
  1249.                                     k% = LEN(MID$(x$(i% - 1), 1, INSTR(x$(i% - 1), CHR$(10)) - 1))
  1250.                                 NEXT i%
  1251.  
  1252.                                 FOR c_s_index% = 1 TO c_s_travel% - 1: autokey = -1: b$ = CHR$(0) + "K": GOSUB getkeyauto: NEXT
  1253.                             CASE CHR$(0) + "t"
  1254.                                 c_s_travel% = 0: c_s_tracker% = 0
  1255.                                 k% = POS(0) - margin.l
  1256.                                 a1$ = MID$(x$(row + scr), k%, 1)
  1257.                                 IF a1$ = CHR$(32) THEN g% = -1 ELSE g% = 1
  1258.                                 FOR i% = row + scr TO noe
  1259.                                     a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
  1260.                                     FOR j% = k% TO LEN(a1$)
  1261.                                         SELECT CASE g%
  1262.                                             CASE -1
  1263.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
  1264.                                                     k% = -1: EXIT FOR
  1265.                                                     IF MID$(a1$, j%, 1) <> CHR$(32) THEN
  1266.                                                         k% = -1: EXIT FOR
  1267.                                                     ELSE
  1268.                                                         c_s_tracker% = c_s_tracker% + 1
  1269.                                                     END IF
  1270.                                                 END IF
  1271.                                             CASE 1
  1272.                                                 IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
  1273.                                                     k% = -1: EXIT FOR
  1274.                                                 ELSE
  1275.                                                     IF MID$(a1$, j%, 1) = CHR$(32) THEN
  1276.                                                         c_s_tracker% = c_s_tracker% + 1
  1277.                                                     ELSE
  1278.                                                         IF c_s_tracker% THEN k% = -1: EXIT FOR
  1279.                                                     END IF
  1280.                                                 END IF
  1281.                                         END SELECT
  1282.                                         c_s_travel% = c_s_travel% + 1
  1283.                                     NEXT j%
  1284.                                     IF k% = -1 THEN EXIT FOR
  1285.                                     k% = 1
  1286.                                 NEXT i%
  1287.  
  1288.                                 FOR c_s_index% = 1 TO c_s_travel%: autokey = -1: b$ = CHR$(0) + "M": GOSUB getkeyauto: NEXT
  1289.                             CASE CHR$(0) + "K"
  1290.                                 IF POS(0) > margin.l + 1 + border.thk THEN
  1291.                                     LOCATE , POS(0) - 1
  1292.                                 ELSE
  1293.                                     IF row = 1 AND scr = 0 THEN
  1294.                                         ' Do nothing.
  1295.                                     ELSE
  1296.                                         b$ = b$ + CHR$(0) + "H" + CHR$(0) + "O"
  1297.                                     END IF
  1298.                                 END IF
  1299.                             CASE CHR$(0) + "M"
  1300.                                 IF POS(0) < n% THEN
  1301.                                     LOCATE , POS(0) + 1
  1302.                                 ELSE
  1303.                                     IF row + scr < noe OR row + scr = noe AND LEN(a$) > dwidth OR row + scr = noe AND INSTR(a$, CHR$(255)) THEN
  1304.                                         b$ = b$ + CHR$(0) + "P" + CHR$(0) + "G"
  1305.                                     END IF
  1306.                                 END IF
  1307.                             CASE CHR$(0) + "I"
  1308.                                 LOCATE , margin.l + 1
  1309.                                 k% = page.h - 1 + row - 2
  1310.                                 FOR j% = 0 TO k%
  1311.                                     b$ = b$ + CHR$(0) + "H"
  1312.                                 NEXT
  1313.                                 FOR j% = 1 TO row - 1
  1314.                                     b$ = b$ + CHR$(0) + "P"
  1315.                                 NEXT
  1316.                                 b$ = b$ + CHR$(0) + "G"
  1317.                             CASE CHR$(0) + "Q"
  1318.                                 LOCATE , margin.l + 1
  1319.                                 k% = (page.h - 1) + (page.h - row) - 1
  1320.                                 FOR j% = 0 TO k%
  1321.                                     b$ = b$ + CHR$(0) + "P"
  1322.                                 NEXT
  1323.                                 FOR j% = 1 TO page.h - row
  1324.                                     b$ = b$ + CHR$(0) + "H"
  1325.                                 NEXT
  1326.                                 b$ = b$ + CHR$(0) + "G"
  1327.                             CASE CHR$(0) + "G" ' Cursor home on current line.
  1328.                                 LOCATE , margin.l + 1
  1329.                             CASE CHR$(0) + "O" ' Cursor end on current line.
  1330.                                 IF kloop% = 0 THEN ' User key press.
  1331.                                     IF row + scr < noe AND n% - margin.l <= dwidth AND INSTR(a$, CHR$(255)) = 0 THEN
  1332.                                         LOCATE , n% + 1 ' Allows more text to be added to the line in front of the last character.
  1333.                                     ELSE ' last line
  1334.                                         LOCATE , n%
  1335.                                     END IF
  1336.                                 ELSE ' Automated cursor advance. For these routines, the cursor never goes past last character.
  1337.                                     LOCATE , n%
  1338.                                 END IF
  1339.                             CASE CHR$(0) + "w" ' Ctrl + Home
  1340.                                 row = 1
  1341.                                 IF scr > 0 THEN
  1342.                                     scr = 0
  1343.                                     h% = 0: GOSUB scrollscrn
  1344.                                 END IF
  1345.                                 LOCATE margin.t + 1, margin.l + 1
  1346.                             CASE CHR$(0) + "u" ' Ctrl + End
  1347.                                 IF noe > page.h THEN
  1348.                                     row = page.h
  1349.                                     scr = noe - row
  1350.                                     LOCATE margin.t + 1, margin.l + 1
  1351.                                     h% = 0: GOSUB scrollscrn
  1352.                                     LOCATE margin.t + page.h, margin.l + dwidth
  1353.                                 ELSE
  1354.                                     row = noe
  1355.                                     LOCATE margin.t + row, margin.l + dwidth
  1356.                                 END IF
  1357.                                 IF LEN(MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)) = dwidth + 1 THEN b$ = b$ + CHR$(0) + "P"
  1358.                                 b$ = b$ + CHR$(0) + "O"
  1359.                             CASE CHR$(0) + "R"
  1360.                                 IF ins% = 30 THEN ins% = 7 ELSE ins% = 30
  1361.                                 LOCATE , , 1, 7, ins%
  1362.                             CASE CHR$(9)
  1363.                                 RUN
  1364.                             CASE CHR$(27)
  1365.                                 SYSTEM
  1366.                             CASE CHR$(0) + "S"
  1367.                                 IF row = 1 AND scr = 0 THEN IF INSTR(x$(1), CHR$(10)) <= 0 THEN b$ = "": EXIT DO
  1368.                                 updatescrn% = 1
  1369.                                 IF POS(0) - margin.l > LEN(a$) AND row + scr < noe THEN
  1370.                                     b$ = "**" + CHR$(0) + "G" + CHR$(0) + "P": autodelforward% = -1
  1371.                                 ELSE ' delete the character under the cursor.
  1372.                                     a$ = MID$(a$, 1, POS(0) - margin.l - 1) + MID$(a$, POS(0) - margin.l + 1)
  1373.                                     IF a$ = "" AND INSTR(x$(row + scr), CHR$(10)) <= 1 THEN '
  1374.                                         ' Take no action. blank doc.
  1375.                                     ELSE ' Delete character from current cursor position.
  1376.                                         IF MID$(a$, POS(0) - margin.l, 1) = "" THEN
  1377.                                             IF row + scr < noe THEN ' The furthest right character on the line was deleted, and now the cursor must be positioned at the start of the next line, otherwise cur$ would be null.
  1378.                                                 '1 of 2 places CUR$ replacement is set. >>>
  1379.                                                 cur$ = LEFT$(x$(row + scr + 1), 1): MID$(x$(row + scr + 1), 1, 1) = CHR$(4)
  1380.                                             ELSE
  1381.                                                 IF row + scr > 1 THEN
  1382.                                                     cur$ = "eod"
  1383.                                                 ELSE
  1384.                                                     ' Do nothing. Single line no wrap possible.
  1385.                                                 END IF
  1386.                                             END IF
  1387.                                         ELSE ' character deleted was at or between the first and next to the last character on the line.
  1388.                                             cur$ = MID$(a$, POS(0) - margin.l, 1): MID$(a$, POS(0) - margin.l, 1) = CHR$(4)
  1389.                                         END IF
  1390.                                         b$ = "exit": EXIT DO
  1391.                                     END IF
  1392.                                 END IF
  1393.                             CASE CHR$(8)
  1394.                                 IF POS(0) = margin.l + 1 AND row = 1 AND scr = 0 THEN
  1395.                                     ' First character of doc. Do not delete using backspace.
  1396.                                 ELSE
  1397.                                     b$ = "**" + CHR$(0) + "K": autobkspdel% = -1
  1398.                                 END IF
  1399.                             CASE CHR$(32) TO CHR$(127)
  1400.                                 updatescrn% = 1
  1401.                                 j% = POS(0)
  1402.                                 k% = j% - (margin.l + border.thk)
  1403.                                 ' 1 of 2 places CUR$ replacement is set. >>>
  1404.                                 SELECT CASE ins%
  1405.                                     CASE 30 'Overwrite
  1406.                                         cur$ = b$
  1407.                                         IF k% <= LEN(a$) AND k% <= dwidth THEN
  1408.                                             MID$(a$, k%, 1) = CHR$(4) ' Display occurs in FOR/NEXT print to screen routine.
  1409.                                         ELSEIF j% = margin.l + dwidth + 1 THEN
  1410.                                             IF RIGHT$(a$, 1) = CHR$(32) AND LEN(a$) = dwidth + 1 THEN
  1411.                                                 MID$(a$, k%, 1) = CHR$(4)
  1412.                                             ELSE
  1413.                                                 a$ = a$ + CHR$(4)
  1414.                                                 IF row + scr < noe AND INSTR(x$(row + scr + 1), CHR$(10)) - 1 > 1 THEN
  1415.                                                     x$(row + scr + 1) = MID$(x$(row + scr + 1), 2)
  1416.                                                 END IF
  1417.                                             END IF
  1418.                                         ELSE
  1419.                                             a$ = a$ + CHR$(4)
  1420.                                         END IF
  1421.                                         curadvance% = 1: b$ = "exit"
  1422.                                         EXIT DO
  1423.                                     CASE 7 ' Insert
  1424.                                         cur$ = b$
  1425.                                         a$ = MID$(a$, 1, k% - 1) + CHR$(4) + MID$(a$, k%)
  1426.                                         curadvance% = 1: b$ = "exit"
  1427.                                         EXIT DO
  1428.                                 END SELECT
  1429.  
  1430.                             CASE CHR$(0) + ">"
  1431.                                 IF POS(0) - (margin.l + border.thk) < dwidth + 1 THEN
  1432.                                     LOCATE , POS(0) + 1
  1433.                                     b$ = "exit"
  1434.                                 ELSE
  1435.                                     IF row + scr < noe OR row + scr = noe AND LEN(a$) > dwidth THEN
  1436.                                         b$ = b$ + CHR$(0) + "P" + CHR$(0) + "G"
  1437.                                     END IF
  1438.                                 END IF
  1439.                             CASE CHR$(0) + "^"
  1440.                                 IF row = page.h THEN
  1441.                                     scr = scr + 1
  1442.                                     GOSUB scrollscrn
  1443.                                 ELSE
  1444.                                     row = row + 1
  1445.                                     GOSUB movescrollbox
  1446.                                 END IF
  1447.  
  1448.                                 LOCATE margin.t + row, margin.l + 1
  1449.                                 b$ = "exit"
  1450.  
  1451.                             CASE CHR$(0) + CHR$(0)
  1452.                                 b$ = "exit-partial"
  1453.                             CASE ""
  1454.                                 b$ = "exit": EXIT DO
  1455.                         END SELECT
  1456.  
  1457.                         row = CSRLIN - margin.t
  1458.  
  1459.                         kloop% = kloop% + 2
  1460.                         IF kloop% > 4 AND curadvance% THEN b$ = "exit": EXIT DO ' Allow a coming return back to the curadvance gosub getkeyauto line.
  1461.  
  1462.                     END IF ' mark% vs non-mark%
  1463.  
  1464.                 LOOP WHILE reloop%
  1465.  
  1466.             LOOP UNTIL mhl% = 0
  1467.  
  1468.             IF MID$(b$, 1, 4) = "exit" THEN EXIT DO ' exit and exit-partial exits here.
  1469.         LOOP
  1470.         IF b$ = "exit-partial" THEN b$ = ""
  1471.  
  1472.     END IF
  1473.  
  1474.     IF b$ = "exit" THEN b$ = "": EXIT DO
  1475.  
  1476.     ' Audit Mouse Routines ====================================================
  1477.     DO
  1478.         mb.w = 0
  1479.         WHILE _MOUSEINPUT
  1480.             mb.w = mb.w + _MOUSEWHEEL
  1481.         WEND
  1482.  
  1483.         IF mb.w = 0 THEN
  1484.             mx% = _MOUSEX ' Mouse column.
  1485.             my% = _MOUSEY ' Mouse row.
  1486.             mb.l = _MOUSEBUTTON(1)
  1487.             mb.r = _MOUSEBUTTON(2)
  1488.             mb.m = _MOUSEBUTTON(3)
  1489.         END IF
  1490.  
  1491.         IF locked% < 0 THEN ' Mouse effects on mouse lock. key press effects are determined at inkey$ input, as key variable cannot be evaluated here, due to b$ = "" manipulations in the keypress routine.
  1492.             IF mb.l OR mb.r OR mb.m THEN locked% = 0
  1493.         END IF
  1494.  
  1495.         IF mb.w THEN ' Determine if wheel is being used to scroll highlighted or unhighlighted text.
  1496.             IF shift% THEN
  1497.                 locked% = -1
  1498.                 mhl1row% = row: mhl1col% = col: mhl1% = (row - 1) * dwidth2 + col
  1499.             ELSE
  1500.                 locked% = 2 ' 2 is lock scrollbar, no highlighting permitted.
  1501.             END IF
  1502.         END IF
  1503.  
  1504.         IF mb.l AND locked% <> 1 OR mb.w AND locked% <> -1 THEN
  1505.             ' Scrollbar routine.
  1506.             IF mx% >= scrb.l - 1 AND mx% <= scrb.l + 1 AND my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 THEN draglock% = -1
  1507.             IF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR mx% = scrb.l AND scrb.s <> 0 AND my% >= scrb.t AND my% <= scrb.b AND mb.w = 0 OR scrbardrag% <> 0 AND my% > scrb.t AND my% < scrb.b AND mb.w = 0 OR mb.w > 0 AND scrb.x + scrb.s < scrb.h OR mb.w < 0 AND scrb.x > 0 THEN ' Mouse on scrollbar, doing a bar cursor drag or using the scroll wheel.
  1508.                 locked% = 2 ' Locked on scrollbar
  1509.                 IF my% = scrb.t AND scrb.x > 0 OR my% = scrb.b AND scrb.x + scrb.s < scrb.h OR mb.w <> 0 THEN ' Mouse on a scrollbar arrow.
  1510.                     IF my% = scrb.t AND mb.w = 0 OR mb.w < 0 THEN scrb.x = scrb.x - 1: h% = -1 ELSE scrb.x = scrb.x + 1: h% = -2 ' Top or bottom arrow.
  1511.                     IF mb.w = 0 THEN delay.on! = .15
  1512.                     j% = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
  1513.  
  1514.                     IF j% >= 0 THEN ' Condition exists unless j% is negative such as doc is blank and mouse wheel is rolled downward.
  1515.                         scrb.i = j%
  1516.  
  1517.                         IF mark% = 0 THEN h% = 0 ' h% was assigned a few lines up but gets zeroed here if there is no highlighting.
  1518.  
  1519.                         scr = scrb.i
  1520.  
  1521.                         GOSUB makescrb ' Positions scrollbar box.
  1522.  
  1523.                         GOSUB scrollscrn
  1524.                     END IF
  1525.  
  1526.                 ELSEIF my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 AND scrbardrag% = 0 THEN ' Mouse on scrollbar block.
  1527.                     scrbardrag% = -1: scrb.adjust = (my% - (scrb.t + 1)) - scrb.x
  1528.                 ELSEIF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR my% > scrb.t AND my% < scrb.b THEN ' Mouse on scrollbar between scrollbar arrow and cursor.
  1529.                     IF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR my% - (scrb.t + 1) - scrb.adjust >= 0 AND my% - (scrb.t + 1) + scrb.s - scrb.adjust <= scrb.h AND scrbardrag% <> -1 OR scrbardrag% = 0 THEN
  1530.                         IF scrbardrag% = 0 THEN ' No drag, so adjust for cursor length for a click inside the scrollbar above or below the current scrollbar cursor position.
  1531.                             IF my% - (scrb.t + 1) > scrb.x THEN
  1532.                                 scrb.adjust = (my% - (scrb.t + 1)) - scrb.x - 1: h% = -1
  1533.                             ELSE
  1534.                                 scrb.adjust = (my% - (scrb.t + 1)) - scrb.x + 1: h% = -2
  1535.                             END IF
  1536.                         END IF
  1537.                         scrb.x = my% - (scrb.t + 1) - scrb.adjust
  1538.                         scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
  1539.  
  1540.                         IF mark% = 0 THEN h% = 0 ' h% was assigned a few lines up but gets zeroed here if there is no highlighting.
  1541.  
  1542.                         scr = scrb.i
  1543.  
  1544.                         GOSUB makescrb
  1545.  
  1546.                         GOSUB scrollscrn
  1547.  
  1548.                     ELSE ' Scrollbar is at top or bottom and mouse cursor is moving vertically along the scrollbar cursor. This allows the variable to readjust.
  1549.                         IF mx% = scrb.l THEN scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
  1550.                     END IF
  1551.                 END IF
  1552.                 ' =======================================================
  1553.  
  1554.                 IF scr < cursor.top OR scr > cursor.bot THEN
  1555.                     LOCATE , , 0: curhide% = -1
  1556.                 ELSE
  1557.                     IF mark% = 0 THEN
  1558.                         IF row + scr <> cursor.scbrrow AND cursor.scbrrow <> 0 THEN
  1559.                             row = cursor.scbrrow - scr
  1560.                             LOCATE margin.t + row, POS(0)
  1561.                         END IF
  1562.                         LOCATE , , 1: curhide% = 0
  1563.                     ELSE
  1564.                         LOCATE , , 1: curhide% = 0
  1565.                     END IF
  1566.                 END IF
  1567.  
  1568.             END IF
  1569.  
  1570.             IF delay.on! THEN ' Scrollbar delay.
  1571.                 _DELAY delay.on!
  1572.                 delay.on! = 0 ' Toggle off.
  1573.             END IF
  1574.  
  1575.             IF locked% = 2 THEN EXIT DO
  1576.         ELSE
  1577.             scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
  1578.             IF locked% = 2 AND mb.l = 0 THEN locked% = 0
  1579.         END IF
  1580.  
  1581.         IF mb.w AND locked% = -1 THEN ' shift key down. Mouse wheel highlighting.
  1582.             IF mb.w > 0 THEN
  1583.                 b$ = CHR$(0) + "P"
  1584.             ELSE
  1585.                 b$ = CHR$(0) + "H"
  1586.             END IF
  1587.             autokey% = -1 ' Note: Gosub getkeyauto will not work here.
  1588.             EXIT DO
  1589.         END IF
  1590.  
  1591.         IF mb.l THEN
  1592.             IF mx% > margin.l AND mx% <= margin.l + dwidth + 1 AND my% >= margin.t + 1 AND my% <= margin.t + page.h OR mark% <> 0 AND locked% = 1 OR mark% <> 0 AND locked% = 3 THEN ' Cursor in-bounds.
  1593.                 IF curhide% THEN curhide% = 0: row = my% - margin.t: col = mx% - margin.l: LOCATE margin.t + row, margin.l + col, 1: EXIT DO
  1594.                 j% = 0: ii2% = my% - margin.t
  1595.                 IF ii2% < 1 THEN
  1596.                     ii2% = 1
  1597.                     j% = -1
  1598.                     locked% = 3
  1599.                 ELSEIF ii2% > noe THEN
  1600.                     ii2% = noe
  1601.                     j% = 1
  1602.                     locked% = 3
  1603.                 ELSEIF ii2% > page.h THEN
  1604.                     ii2% = page.h
  1605.                     j% = 1
  1606.                     locked% = 3
  1607.                 END IF
  1608.  
  1609.                 a1$ = MID$(x$(ii2% + scr), 1, INSTR(x$(ii2% + scr), CHR$(10)) - 1)
  1610.  
  1611.                 mxalt% = mx%
  1612.                 IF mx% < margin.l + 1 THEN mxalt% = margin.l + 1
  1613.                 IF mx% > margin.l + LEN(a1$) THEN
  1614.                     mxalt% = margin.l + LEN(a1$) + 1
  1615.                     IF mxalt% - margin.l > dwidth + 1 THEN mxalt% = margin.l + dwidth + 1
  1616.                 END IF
  1617.                 IF INSTR(a1$, CHR$(255)) THEN
  1618.                     IF LEFT$(a1$, 1) = CHR$(255) THEN
  1619.                         mxalt% = margin.l + 1
  1620.                     ELSE
  1621.                         IF mx% - margin.l > LEN(a1$) THEN maxalt% = margin.l + LEN(a1$) - 1
  1622.                     END IF
  1623.                 END IF
  1624.  
  1625.                 IF my% > margin.t + page.h OR my% < margin.t + 1 THEN
  1626.                     IF mark% THEN
  1627.                         IF j% = -1 THEN
  1628.                             IF scr > 0 THEN
  1629.                                 col = mxalt% - margin.l
  1630.                                 LOCATE margin.t + ii2%, margin.l + col
  1631.                                 row = row + 1: scr = scr - 1
  1632.                                 h% = 2: GOSUB scrollscrn
  1633.                                 row = CSRLIN - margin.t
  1634.                             END IF
  1635.                         ELSE
  1636.                             IF ii2% + scr < noe% THEN
  1637.                                 col = mxalt% - margin.l
  1638.                                 LOCATE margin.t + ii2%, margin.l + col
  1639.                                 row = row - 1: scr = scr + 1
  1640.                                 h% = page.h - 1: GOSUB scrollscrn
  1641.                                 row = CSRLIN - margin.t
  1642.                             END IF
  1643.                         END IF
  1644.                     END IF
  1645.                 END IF
  1646.  
  1647.                 IF mhlclear% THEN ' Check to see if highlighting should be removed.
  1648.                     IF shift% THEN ' Do not remove highlighted text.
  1649.                         mhlclear% = 0
  1650.                     ELSE
  1651.                         GOSUB hlwipescrn ' Remove highlighted text.
  1652.                     END IF
  1653.                 END IF
  1654.  
  1655.                 IF shift% OR (ii2% - 1) * dwidth2 + mxalt% - margin.l <> mhl1% AND mhl1% <> 0 THEN
  1656.                     mhl% = -1 ' Left mouse key highlighting enabled when Shift key held and left mouse button click or when Shift held or not held if left mouse button is held while changing row/column (drag).
  1657.                     locked% = 1
  1658.                     mhl1row% = ii2%: mhl1col% = mxalt% - margin.l: mhl1% = (ii2% - 1) * dwidth2 + mxalt% - margin.l
  1659.                     EXIT DO
  1660.                 ELSE
  1661.                     IF mhl1% <> (ii2% - 1) * dwidth2 + mxalt% - margin.l THEN
  1662.                         mhl1% = (ii2% - 1) * dwidth2 + mxalt% - margin.l
  1663.                         row = ii2%: col = mxalt% - margin.l
  1664.                         LOCATE margin.t + row, margin.l + col
  1665.                         curhide% = 0: GOSUB getcurinfo: LOCATE , , 1
  1666.                     END IF
  1667.                 END IF
  1668.             END IF
  1669.         ELSE
  1670.             mhl1% = 0 ' Left mouse button not engaged so zero the highlighting marker.
  1671.             IF locked% AND mb.w = 0 THEN locked% = 0 ' Undo mouse lock unless mouse wheel is in current use.
  1672.             IF mark% THEN mhlclear% = -1 ' Will be triggered the next time the left mouse button is pressed to remove all highlighted text.
  1673.         END IF
  1674.         EXIT DO
  1675.     LOOP ' Mouse loop terminates here.
  1676.  
  1677. IF noe < row + scr THEN noe = row + scr
  1678. RETURN ' ==================================================================
  1679.  
  1680. '==========================================================================
  1681. '                                  NOTES
  1682.     INSTR(x$(c%), CHR$(10)) > 1 Indicates an array with text.
  1683.     INSTR(x$(row + scr), CHR$(10)) <= 1 Indicates an array without text.
  1684.     Value = 0: (Valid)   Array is empty with no EOL.
  1685.     Value = 1: (Invalid) Array is empty but has a EOL added. This should not be present, but I think it occurs when a line is initially erased. This needs more investigation.
  1686.     Value > 1: (Valid)   Array contains text.
  1687. '==========================================================================
  1688.  
  1689. getvar_setscrn:
  1690. scrn.w = _WIDTH
  1691. scrn.h = _HEIGHT
  1692. scrb.x = 0 ' Relative position of the scrollbar cursor from top of scrb.h. 0 Off / 1 to
  1693. page.w = scrn.w - (margin.l + margin.r)
  1694. page.h = scrn.h - (margin.t + margin.b)
  1695. scrb.t = margin.t + 1
  1696. scrb.b = margin.t + page.h
  1697. scrb.l = margin.l + page.w + 2
  1698. page.w = scrn.w - (margin.l + margin.r)
  1699. page.h = scrn.h - (margin.t + margin.b)
  1700. scrb.d = scrb.b - scrb.t + 1
  1701. scrb.h = scrb.b - scrb.t - 1 ' Max. vertical scroll. Bar minus the top and bottom arrow symbols.
  1702.  
  1703. IF noe THEN
  1704.     a$ = "": row = 1: scr = 0
  1705.     FOR i% = 1 TO noe
  1706.         a$ = a$ + MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
  1707.     NEXT
  1708.     wrap.on% = -1: GOSUB wrapper
  1709.     noe = filled%: filled% = 0
  1710.  
  1711. WIDTH scrn.w, scrn.h: CLS
  1712. LOCATE margin.t + 1, margin.l + 1, 1, 7, ins%
  1713. row = CSRLIN - margin.t: scr = 0
  1714. filled% = noe
  1715.  
  1716. IF page.h > noe THEN
  1717.     scrb.s = 0 ' No scroll box required.
  1718.     IF scrb.opt = 0 THEN
  1719.         scrb.s = (scrb.h + 1) * 2 - noe: IF scrb.s <= 0 THEN scrb.s = 1
  1720.     ELSE
  1721.         scrb.s = 1
  1722.     END IF
  1723.  
  1724. IF row = 0 THEN row = 1
  1725. IF page.c = 0 THEN page.c = 7 ' Cursor apearance as underline.
  1726.  
  1727. GOSUB displaydoc
  1728.  
  1729. LOCATE margin.t + row, margin.l + 1, 1, 7, page.c
  1730.  
  1731. movescrollbox:
  1732. IF page.h > noe THEN
  1733.     scrb.s = 0 ' No scroll box required.
  1734.     RETURN ' Required to prevent unhandled conditions in scrollbar box movement.
  1735.     IF scrb.opt = 0 THEN
  1736.         scrb.s = (scrb.h + 1) * 2 - noe: IF scrb.s <= 0 THEN scrb.s = 1
  1737.     ELSE
  1738.         scrb.s = 1
  1739.     END IF
  1740. IF scr = 0 THEN
  1741.     scrb.x = 0
  1742.     IF scrb.x < page.h - 3 AND row + scr >= INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h THEN
  1743.         scrb.x = 0
  1744.         DO UNTIL scrb.x = scrb.h - scrb.s OR page.h + scr < INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h
  1745.             scrb.x = scrb.x + 1
  1746.         LOOP
  1747.  
  1748.     ELSEIF row + scr < scrb.i THEN
  1749.         scrb.x = page.h - 3
  1750.         DO UNTIL page.h + scr > INT((scrb.x + 1 - 2) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h
  1751.             scrb.x = scrb.x - 1
  1752.         LOOP
  1753.     END IF
  1754.  
  1755. IF scrb.x + scrb.s > scrb.h THEN ' Scrollbox expansion adjustment.
  1756.     scrb.x = scrb.h - scrb.s
  1757.  
  1758. GOSUB makescrb
  1759.  
  1760. scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
  1761.  
  1762. makescrb:
  1763. yy% = CSRLIN: xx% = POS(0)
  1764. LOCATE scrb.t, scrb.l
  1765. COLOR 0, 7
  1766. PRINT CHR$(24);
  1767. COLOR 7, 0
  1768. FOR i% = 1 TO scrb.h
  1769.     LOCATE scrb.t + i%, scrb.l
  1770.     PRINT CHR$(177);
  1771. NEXT i%
  1772. LOCATE scrb.b, scrb.l
  1773. COLOR 0, 7
  1774. PRINT CHR$(25);
  1775. COLOR 7, 0
  1776. IF noe > scrb.h + 2 THEN
  1777.     FOR i% = 1 TO scrb.s
  1778.         LOCATE scrb.t + scrb.x + i%, scrb.l
  1779.         COLOR 1, 0
  1780.         PRINT CHR$(176); ' Scrollbar box.
  1781.     NEXT
  1782.     COLOR 7, 0
  1783. LOCATE yy%, xx%
  1784.  
  1785. getcurinfo:
  1786. cursor.scbrrow = row + scr
  1787. cursor.scbrcol = POS(0) - margin.l
  1788. cursor.holdscr = scr
  1789. cursor.holdrow = row
  1790. cursor.top = scr - page.h + row
  1791. cursor.bot = scr + row - 1
  1792. cursor.holdscrbx = scrb.x
  1793.  
  1794. backtocursor:
  1795. scr = cursor.holdscr
  1796. row = 1
  1797. LOCATE margin.t + row, margin.l + 1
  1798. filled% = page.h: GOSUB displaydoc
  1799. row = cursor.holdrow
  1800. col = cursor.scbrcol
  1801. scrb.x = cursor.holdscrbx
  1802. scrb.i = scr
  1803. curhide% = 0
  1804. GOSUB getcurinfo
  1805. LOCATE margin.t + row, margin.l + col, 1
  1806.  
  1807. highlighter:
  1808. yy% = CSRLIN: xx% = POS(0)
  1809.  
  1810. IF cutmrow% THEN
  1811.     cutdrow% = row + scr: cutdcol% = col ' Also found in scrollscrn routine.
  1812.  
  1813. IF o% = 0 THEN
  1814.     o% = mark%
  1815.     o% = d% ' o% is the start marker or last marker. If zero, it is the same as the start marker (mark%) but if the highlighting process is ongoing, it is the same as the last highlighting marker (d%).
  1816.  
  1817. hlbypass% = -1: GOSUB markercalc ' o% has already been set. hlbypass% gets zeroed in gosub statement.
  1818.  
  1819. IF d% >= o% THEN mov% = 1 ELSE mov% = -1: ' Difference between origin and destination markers determine if the movement is positive (right, down) or negative (left, up).
  1820.  
  1821.     CASE 1 ' End, right, or down
  1822.         x1% = o1%: x2% = o2%: LOCATE margin.t + x1%, margin.l + x2%
  1823.         a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
  1824.         ' Highlighting on line above, from origin row.
  1825.         IF x1% = markrow% AND o1% = d1% AND mhl% THEN ' Mouse only when the origin row is the same as the original marker row and the destination row is the same as the origin row. This is right movement within the same line of text.
  1826.             i% = 0: DO UNTIL i% = d2% - x2%: GOSUB getcolor: PRINT MID$(a1$, x2% + i%, 1);: i% = i% + 1: LOOP
  1827.         ELSEIF x1% = markrow% AND ABS(o% - d%) > 1 THEN ' End key press. Exclude mouse here, as down mouse highlighting is done in a conditional statement, below.
  1828.             GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(o2% - markcol%)); ' Print from origin column to initial marker column.
  1829.             GOSUB getcolor: PRINT MID$(a1$, x2% + ABS(o2% - markcol%)); ' Print from initial marker column to destination column.
  1830.         ELSE ' Right arrow key, down arrow key or mouse moving down.
  1831.             GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(o1% - d1%) * dwidth2 + ABS(o2% - d2%)); ' Trick method to determine length of highlighting.
  1832.         END IF
  1833.  
  1834.         IF o1% - d1% THEN ' Highlighting on current row after row above is finished.
  1835.             x1% = row: x2% = col: LOCATE margin.t + x1%, margin.l + 1
  1836.             a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
  1837.             IF x1% = markrow% AND ABS(o% - d%) > 1 THEN ' Highlight the destination row if downward move is made after an upward highlight has been made.
  1838.                 IF d2% < markcol% THEN i% = d2% ELSE i% = markcol% ' Set i% to the furthest column.
  1839.                 GOSUB getcolor: PRINT MID$(a1$, 1, i% - 1); ' unhighlight to the furthest column.
  1840.                 GOSUB getcolor: PRINT MID$(a1$, i%, ABS(d2% - i%));
  1841.             ELSE ' Arrow down or mouse downward, either with original marker row on same line.
  1842.                 GOSUB getcolor: PRINT MID$(a1$, 1, d2% - 1); ' Highlight from first column on current row to destination on current row.
  1843.             END IF
  1844.         END IF
  1845.  
  1846.     CASE -1 ' Home, up, or Left.
  1847.         x1% = row: x2% = col: LOCATE margin.t + x1%, margin.l + x2%
  1848.         a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
  1849.  
  1850.         IF x1% = markrow% AND o1% = d1% AND mhl% THEN ' Mouse only when the origin row is the same as the original marker row and the destination row is the same as the origin row. This is left movement within the same line of text.
  1851.             IF mx% - margin.l <= LEN(a1$) THEN
  1852.                 i% = 0: DO UNTIL i% = o2% - x2%: GOSUB getcolor: PRINT MID$(a1$, x2% + i%, 1);: i% = i% + 1: LOOP
  1853.             END IF
  1854.         ELSEIF x1% = markrow% AND ABS(o1% - d1%) >= 1 THEN ' Mouse or arrow back up to highlighted line above.
  1855.             GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(d2% - markcol%)); ' Highlight from cursor to previously highlighted text to the right, if any.
  1856.             GOSUB getcolor: PRINT MID$(a1$, x2% + ABS(d2% - markcol%)); ' Unhighlight previous text to the right.
  1857.         ELSE ' Arrow left, home, arrow up or mouse upwards, either without any highlighting above.
  1858.             GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(o1% - d1%) * dwidth2 + ABS(o2% - d2%)); ' Trick method to determine length of highlighting.
  1859.         END IF
  1860.  
  1861.         IF o1% <> d1% AND d2% <= o2% THEN ' Bottom line with arrow up or mouse upwards. Note: Mouse initially moves straight up, and moves laterally in another pass. This is why o2% always equals d2% as with an arrow up move.
  1862.             x1% = o1%: x2% = o2%: LOCATE margin.t + x1%, margin.l + 1
  1863.             a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
  1864.  
  1865.             IF x1% = markrow% THEN
  1866.                 IF markcol% >= d2% THEN i% = d2% ELSE i% = markcol%
  1867.                 GOSUB getcolor: PRINT MID$(a1$, 1, i% - 1);
  1868.                 GOSUB getcolor: PRINT MID$(a1$, i%, ABS(i% - d2%));
  1869.             ELSE
  1870.                 IF x1% = page.h AND dmodify% THEN d2% = d2% + dmodify%
  1871.                 GOSUB getcolor: PRINT MID$(a1$, 1, d2% - 1);
  1872.             END IF
  1873.         END IF
  1874.  
  1875. dmodify% = 0
  1876. IF d% = mark% THEN GOSUB clearmarkers
  1877.  
  1878. COLOR c1%, c2%
  1879. LOCATE yy%, xx%
  1880.  
  1881. GOSUB movescrollbox
  1882.  
  1883.  
  1884. getcolor: ' Reads the screen under the cursor and reverses the colors.
  1885. IF POS(0) - margin.l > dwidth + 1 THEN ' Cursor in scrollbar space after full line of text was printed.
  1886.     COLOR h1%, h2%
  1887.     IF SCREEN(CSRLIN, POS(0), 1) <> 7 THEN COLOR c1%, c2% ELSE COLOR h1%, h2%
  1888.  
  1889. copytext:
  1890. _CLIPBOARD$ = "": myCLIPBOARD$ = ""
  1891. i1% = cutmrow%: i2% = cutdrow%
  1892. IF i1% > i2% THEN SWAP i1%, i2%
  1893. j% = cutmcol%: k% = cutdcol%
  1894. IF cutmrow% > cutdrow% THEN SWAP j%, k%
  1895.  
  1896. IF cutmrow% = cutdrow% THEN
  1897.     myCLIPBOARD$ = MID$(x$(i1%), j%, k% - j%)
  1898.     IF INSTR(myCLIPBOARD$, CHR$(255)) THEN a1$ = myCLIPBOARD$: MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = a1$ + CHR$(10) ELSE _CLIPBOARD$ = myCLIPBOARD$
  1899.     a1$ = MID$(MID$(x$(i1%), 1, INSTR(x$(i1%), CHR$(10)) - 1), j%)
  1900.     myCLIPBOARD$ = a1$
  1901.     IF INSTR(a1$, CHR$(255)) THEN MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = _CLIPBOARD$ + a1$ + CHR$(10) ELSE _CLIPBOARD$ = _CLIPBOARD$ + a1$
  1902.     FOR i% = 1 TO i2% - i1% - 1
  1903.         a1$ = MID$(x$(i1% + i%), 1, INSTR(x$(i1% + i%), CHR$(10)) - 1)
  1904.         myCLIPBOARD$ = myCLIPBOARD$ + a1$
  1905.         IF INSTR(a1$, CHR$(255)) THEN MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = _CLIPBOARD$ + a1$ + CHR$(10) ELSE _CLIPBOARD$ = _CLIPBOARD$ + a1$
  1906.     NEXT
  1907.     a1$ = MID$(x$(i2%), 1, k% - 1)
  1908.     myCLIPBOARD$ = myCLIPBOARD$ + a1$
  1909.     IF INSTR(a1$, CHR$(255)) THEN MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = _CLIPBOARD$ + a1$ + CHR$(10) ELSE _CLIPBOARD$ = _CLIPBOARD$ + a1$
  1910.  
  1911. singlelinedelete:
  1912. a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
  1913. IF cutmcol% < cutdcol% THEN j% = cutmcol%: k% = cutdcol% ELSE j% = cutdcol%: k% = cutmcol%
  1914. GOSUB clearmarkers
  1915. a2$ = MID$(a1$, 1, j% - 1)
  1916. a3$ = MID$(a1$, k%)
  1917. IF a3$ = "" THEN
  1918.     cur$ = "eod"
  1919.     cur$ = MID$(a3$, 1, 1): MID$(a3$, 1, 1) = CHR$(4)
  1920. a$ = a2$ + a3$
  1921.  
  1922. multilinedelete:
  1923. i1% = cutmrow%: i2% = cutdrow%
  1924. j% = cutmcol%: k% = cutdcol%
  1925. IF i1% > i2% THEN SWAP i1%, i2%: SWAP j%, k% ' Highlighting was upwards instead of downwards.
  1926.  
  1927. GOSUB clearmarkers
  1928.  
  1929. oldrow = row: oldscr = scr
  1930. a2$ = MID$(x$(i1%), 1, j% - 1)
  1931. a1$ = MID$(x$(i2%), 1, INSTR(x$(i2%), CHR$(10)) - 1)
  1932. a3$ = MID$(a1$, k%)
  1933. b$ = ""
  1934.  
  1935. IF a3$ = "" THEN
  1936.     IF i2% < noe THEN
  1937.         cur$ = MID$(x$(i2% + 1), 1, 1): MID$(x$(i2% + 1), 1, 1) = CHR$(4)
  1938.     ELSE
  1939.         cur$ = "eod"
  1940.     END IF
  1941.     cur$ = MID$(a3$, 1, 1): MID$(a3$, 1, 1) = CHR$(4)
  1942.  
  1943. a$ = a2$ + a3$
  1944.  
  1945. IF i1% > 1 THEN
  1946.     i1% = i1% - 1
  1947.     a1$ = MID$(x$(i1%), 1, INSTR(x$(i1%), CHR$(10)) - 1)
  1948.     a$ = a1$ + a$
  1949.  
  1950. FOR i% = i1% TO i2%
  1951.     x$(i%) = ""
  1952.  
  1953. row = 1: scr = i1% - row
  1954.  
  1955. a1$ = "": a2$ = "": a3$ = ""
  1956. wrap.on% = -1: GOSUB wrapper
  1957. REDIM _PRESERVE x$(noe + 1)
  1958.  
  1959. IF noe < page.h THEN GOSUB wipescrn ' Wipe screen.
  1960.  
  1961. LOCATE row + margin.t, margin.l + 1
  1962.  
  1963. IF i1% < oldscr THEN ELSE scr = oldscr
  1964.  
  1965. IF scr > 0 THEN ' Adjust towards bottom of screen.
  1966.     IF noe - scr < page.h THEN
  1967.         scr = noe - page.h - 1
  1968.         IF scr < 0 THEN scr = 0
  1969.     END IF
  1970.  
  1971. filled% = page.h: GOSUB displaydoc
  1972. GOSUB movescrollbox
  1973.  
  1974. clipboardconvert:
  1975. myCLIPBOARD$ = _CLIPBOARD$
  1976. DO UNTIL INSTR(myCLIPBOARD$, CHR$(13) + CHR$(10)) = 0
  1977.     j% = INSTR(myCLIPBOARD$, CHR$(13) + CHR$(10))
  1978.     DO UNTIL MID$(myCLIPBOARD$, j%, 2) <> CHR$(13) + CHR$(10)
  1979.         myCLIPBOARD$ = MID$(myCLIPBOARD$, 1, j% - 1) + CHR$(255) + MID$(myCLIPBOARD$, j% + 2)
  1980.         j% = j% + 2
  1981.     LOOP
  1982.  
  1983. debugger:
  1984. ss% = CSRLIN: tt% = POS(0)
  1985. LOCATE 1, 42
  1986. PRINT "mark rw col"; mark%; markrow%; markcol%; "   "
  1987. LOCATE , 42
  1988. PRINT "orig  o1 o2"; o%; "o1% ="; o1%; "o2% ="; o2%; "   "
  1989. LOCATE , 42
  1990. PRINT "dest  d1 d2"; d%; "d1% ="; d1%; "d2% ="; d2%; "   "
  1991. IF mov% > 0 THEN mov$ = "pos" ELSE IF mov% < 0 THEN mov$ = "neg" ELSE mov$ = "neutral"
  1992. LOCATE , 42
  1993. PRINT "moving     "; mov$; "   "
  1994. LOCATE , 42
  1995. PRINT "o2 - d2 =  "; ABS(o1% - d1%); ABS(o2% - d2%); "   "
  1996. LOCATE , 42
  1997. PRINT "yy%   xx%  "; yy%; xx%; "   "
  1998. LOCATE , 42
  1999. PRINT "yy% multi  "; (yy% - 1) * dwidth + col; "   "
  2000. LOCATE , 42
  2001. PRINT "cutmrow%   "; cutmrow%; cutmcol%; "   "
  2002. LOCATE , 42
  2003. PRINT "cutdrow%   "; cutdrow%; cutdcol%; "   "
  2004. LOCATE , 42
  2005. PRINT "row col scr"; row; col; scr; "   "
  2006. LOCATE , 42
  2007. PRINT "mhl1%      "; mhl1%; "   "
  2008. LOCATE , 42
  2009. PRINT "mhl1row%   "; mhl1row%; "   "
  2010. LOCATE , 42
  2011. PRINT "mhl1col%   "; mhl1col%; "   "
  2012. LOCATE , 42
  2013. PRINT "locked%    "; locked%; "   "
  2014. LOCATE , 42
  2015. PRINT "scrb.x  i s"; scrb.x; scrb.i; scrb.s; "   "
  2016. LOCATE , 42
  2017. PRINT "b$         "; b$; kloop%; "            "
  2018. LOCATE , 42
  2019. IF LEN(cur$) THEN cur% = ASC(cur$) ELSE cur% = 0
  2020. PRINT "cur$ cur%  "; cur$; cur%; ""
  2021. LOCATE , 42
  2022. PRINT "noe uboundx "; noe; UBOUND(x$); "            "
  2023. LOCATE , 42
  2024. PRINT "cursor.t / b"; cursor.top; cursor.bot; "    ";
  2025. LOCATE , 42
  2026. PRINT "scrbardrag% "; scrbardrag%; draglock%; "    ";
  2027. LOCATE ss%, tt%
  2028.  

It's really rough, and probably buggy. This is the stage where I start renaming variables, optimize the code and re-order the gosubs to better match the program flow, but this is as far along I am for now. Sorry, no save yet, but you can type in it or take any typed out text and copy and paste it into the app. If you select all (Ctrl + A) and copy (Ctrl + C) from the app, you can paste it to Notepad and save it as "mybetatest.txt" in the same folder you are running this app in. If you do so, you will need to change line two beta% to beta% = 2. The saved Notepad text will now open in the app at the next run.

Merry Christmas

Pete   
« Last Edit: December 28, 2020, 02:16:16 am by Pete »
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #123 on: December 26, 2020, 12:51:04 pm »
Hi guys and gals

I had a fine idea but not so much time! So for now I post this my whishes
Code: QB64: [Select]
  1. DIM SHARED GlInit AS INTEGER, s AS SINGLE, Glactive AS INTEGER
  2.  
  3. A = _NEWIMAGE(800, 600, 32)
  4.  
  5.  
  6. CONST Yellow1 = _RGB32(200, 200, 10, 255), Yellow2 = _RGB32(200, 200, 60, 255), Black = _RGB32(0, 0, 0, 255), Red = _RGB32(230, 0, 0, 255)
  7. _TITLE "Happy Christmas QB64 community!"
  8.  
  9. LOCATE 2, ((_WIDTH / 2) - 80) / 8: PRINT "Opengl graphic demo"
  10. GlInit = -1
  11. Glactive = -1
  12. r = 1
  13. z = 10
  14. s = _PI(2) / z
  15.     IF r > 0.35 THEN r = r - 0.05
  16.     FOR w = 0 TO _PI(2) STEP s / 2
  17.  
  18.         _DELAY .15
  19.     NEXT w
  20. COLOR Yellow1
  21. PRINT " Happy Christmas QB64 community"
  22.  
  23. 'area subs-------------
  24.  
  25. 'area GL --------------------
  26. SUB _GL ()
  27.     SHARED w AS SINGLE
  28.     IF NOT Glactive THEN EXIT SUB
  29.     IF GlInit THEN
  30.         _glViewport 0, 0, _WIDTH, _HEIGHT
  31.         _glClearColor 1, 0, 0, 1
  32.         GlInit = 0
  33.     END IF
  34.     _glClear _GL_COLOR_BUFFER_BIT
  35.     RotatingStarsFull 0, -0.2, r, -w
  36.     IncrDrawPoint 0, -0.2, r, 10, -w
  37.     IncrRotStarsvoid 0, -0.2, r, -w
  38.     'Q
  39.     RotatingStarsFull -0.7, 0.8, 0.05, -w
  40.     RotatingStarsFull -0.8, 0.8, 0.05, -w
  41.     RotatingStarsFull -0.9, 0.7, 0.05, -w
  42.     RotatingStarsFull -0.9, 0.6, 0.05, -w
  43.     RotatingStarsFull -0.9, 0.5, 0.05, -w
  44.     RotatingStarsFull -0.8, 0.4, 0.05, -w
  45.     RotatingStarsFull -0.7, 0.4, 0.05, -w
  46.     RotatingStarsFull -0.6, 0.7, 0.05, -w
  47.     RotatingStarsFull -0.6, 0.6, 0.05, -w
  48.     RotatingStarsFull -0.6, 0.5, 0.05, -w
  49.     RotatingStarsFull -0.55, 0.4, 0.05, -w
  50.     'B
  51.  
  52.     RotatingStarsFull -0.2, 0.8, 0.05, -w
  53.     RotatingStarsFull -0.4, 0.8, 0.05, -w
  54.     RotatingStarsFull -0.4, 0.7, 0.05, -w
  55.     RotatingStarsFull -0.4, 0.6, 0.05, -w
  56.     RotatingStarsFull -0.4, 0.5, 0.05, -w
  57.     RotatingStarsFull -0.4, 0.4, 0.05, -w
  58.     RotatingStarsFull -0.2, 0.4, 0.05, -w
  59.     RotatingStarsFull -0.1, 0.7, 0.05, -w
  60.     RotatingStarsFull -0.2, 0.6, 0.05, -w
  61.     RotatingStarsFull -0.1, 0.5, 0.05, -w
  62.     '6
  63.     RotatingStarsFull 0.4, 0.8, 0.05, -w
  64.     RotatingStarsFull 0.3, 0.8, 0.05, -w
  65.     RotatingStarsFull 0.2, 0.7, 0.05, -w
  66.     RotatingStarsFull 0.1, 0.6, 0.05, -w
  67.     RotatingStarsFull 0.1, 0.5, 0.05, -w
  68.     RotatingStarsFull 0.2, 0.4, 0.05, -w
  69.     RotatingStarsFull 0.3, 0.3, 0.05, -w
  70.     RotatingStarsFull 0.3, 0.3, 0.05, -w
  71.     RotatingStarsFull 0.4, 0.4, 0.05, -w
  72.     RotatingStarsFull 0.3, 0.5, 0.05, -w
  73.     RotatingStarsFull 0.4, 0.5, 0.05, -w
  74.     RotatingStarsFull 0.2, 0.5, 0.05, -w
  75.  
  76.     '4
  77.     RotatingStarsFull 0.8, 0.8, 0.05, -w
  78.     RotatingStarsFull 0.7, 0.7, 0.05, -w
  79.     RotatingStarsFull 0.8, 0.7, 0.05, -w
  80.     RotatingStarsFull 0.6, 0.5, 0.05, -w
  81.     RotatingStarsFull 0.8, 0.6, 0.05, -w
  82.     RotatingStarsFull 0.65, 0.6, 0.05, -w
  83.     RotatingStarsFull 0.7, 0.5, 0.05, -w
  84.     RotatingStarsFull 0.9, 0.5, 0.05, -w
  85.     RotatingStarsFull 0.8, 0.5, 0.05, -w
  86.     RotatingStarsFull 0.8, 0.4, 0.05, -w
  87.     RotatingStarsFull 0.8, 0.3, 0.05, -w
  88.  
  89.     _glFlush
  90.  
  91. SUB IncrDrawPoint (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, s1 AS INTEGER, w AS SINGLE)
  92.     STATIC s2 AS INTEGER
  93.     IF s2 - s1 = 0 THEN s2 = 2 ELSE s2 = s2 + 1
  94.     drawpoint x, y, r1, s2, 2 * s, w
  95.  
  96. SUB IncrRotStarsvoid (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, w AS SINGLE)
  97.     STATIC r2 AS SINGLE
  98.     IF r2 >= r1 THEN r2 = 0 ELSE r2 = r2 + 0.001
  99.     RotatingStarsVoid x, y, r2, w
  100.  
  101. SUB drawpoint (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, s1 AS INTEGER, s2 AS SINGLE, w AS SINGLE)
  102.     DIM i AS SINGLE, cx AS SINGLE, cy AS SINGLE
  103.     _glColor4f 0.8, .8, 0.1, 1.0
  104.     _glPointSize s1 ' it works with 2 or more !
  105.     _glBegin _GL_POINTS
  106.     FOR i = 0 TO _PI(2) STEP s2
  107.         cx = (COS(i + w) * r1) + x
  108.         cy = (SIN(i + w) * r1) + y
  109.         _glVertex2f cx, cy
  110.     NEXT i
  111.     _glEnd
  112.  
  113.  
  114.  
  115.  
  116. SUB RotatingStarsFull (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, w AS SINGLE)
  117.     DIM i, cx AS SINGLE, cy AS SINGLE, j AS INTEGER, k AS INTEGER, h AS INTEGER
  118.     _glColor4f 0.8, .8, 0.1, 1.0
  119.  
  120.     _glBegin _GL_TRIANGLE_FAN
  121.  
  122.     h = 0
  123.     FOR i = 0 TO _PI(2) STEP s
  124.         h = h + 1
  125.         IF h MOD 2 = 0 THEN
  126.             j = 2: k = 1
  127.         ELSE
  128.             j = 1: k = 2
  129.         END IF
  130.  
  131.         cx = (COS(i - s + w) * (r1 / k)) + x
  132.         cy = (SIN(i - s + w) * (r1 / k)) + y
  133.         _glVertex2f cx, cy
  134.  
  135.         cx = (COS(i + w) * (r1 / j)) + x
  136.         cy = (SIN(i + w) * (r1 / j)) + y
  137.         _glVertex2f cx, cy
  138.         cx = (COS(i + s + w) * (r1 / k)) + x
  139.         cy = (SIN(i + s + w) * (r1 / k)) + y
  140.         _glVertex2f cx, cy
  141.     NEXT i
  142.  
  143.     _glEnd
  144.  
  145. SUB RotatingStarsVoid (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, w AS SINGLE)
  146.     DIM i, cx AS SINGLE, cy AS SINGLE, j AS INTEGER, k AS INTEGER, h AS INTEGER
  147.     _glColor4f 0.8, 1, 0.1, 1.0
  148.  
  149.     _glBegin _GL_LINES
  150.  
  151.     h = 0
  152.     FOR i = 0 TO _PI(2) STEP s
  153.         h = h + 1
  154.         IF h MOD 2 = 0 THEN
  155.             j = 2: k = 1
  156.         ELSE
  157.             j = 1: k = 2
  158.         END IF
  159.  
  160.  
  161.         cx = (COS(i + w) * (r1 / j)) + x
  162.         cy = (SIN(i + w) * (r1 / j)) + y
  163.         _glVertex2f cx, cy
  164.         cx = (COS(i + s + w) * (r1 / k)) + x
  165.         cy = (SIN(i + s + w) * (r1 / k)) + y
  166.         _glVertex2f cx, cy
  167.     NEXT i
  168.  
  169.     _glEnd
  170.  

here a screenshot
 
Christmas demo.jpg


Merry Christmas and happy life!

PS all you have posted something of beautiful! Thanks to share these your works!
Programming isn't difficult, only it's  consuming time and coffee

Offline Aurel

  • Forum Regular
  • Posts: 167
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #124 on: December 27, 2020, 09:40:56 am »
I must say that i like your snow-animation Sierraken ;
//////////////////////////////////////////////////////////////////
https://aurelsoft.ucoz.com
https://www.facebook.com/groups/470369984111370
//////////////////////////////////////////////////////////////////

Offline Aurel

  • Forum Regular
  • Posts: 167
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #125 on: December 27, 2020, 09:46:51 am »
Also well done Static ..i like it
StaticCraft.png
* StaticCraft.png (Filesize: 74.52 KB, Dimensions: 1042x827, Views: 81)
//////////////////////////////////////////////////////////////////
https://aurelsoft.ucoz.com
https://www.facebook.com/groups/470369984111370
//////////////////////////////////////////////////////////////////

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #126 on: December 28, 2020, 02:18:08 am »
So did I win? I bet I did. I posted the biggest app on the board. It's huge!!! If I didn't... it's rigged.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #127 on: December 28, 2020, 02:21:25 am »
Aw thanks Aurel!

My first fan art!... jkjk

Glad you liked it!
You're not done when it works, you're done when it's right.

Offline Dav

  • Forum Resident
  • Posts: 792
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #128 on: December 28, 2020, 09:54:27 am »
I gotta say, that landscape thing you posted was pretty doggone awesome, @STxAxTIC. You could turn that into a flight simulator game.

- Dav

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: 🎄🎁✨ Holiday Season - are you ready to code?
« Reply #129 on: December 28, 2020, 12:59:59 pm »
Thanks much @Dav - it's been one of those back-burner projects spanning over a few years. I haven't decided on a proper endgame for this engine... Ditch particles and go with 3d triangles? Commit to particles and do something minecraft-like? If I could live several lifetimes, I would do both...
You're not done when it works, you're done when it's right.