wt [for SAM Coupé, in MBim]
Description of the page content
Text wrapping module for MBim console programs.
wt stands for “wrapping text”. It's a little addon in MBim that makes it possible to print left-justified paragraphs. It was translated and adapted from the X11-Basic version.
Source code
// wt ("wrapping text")
// A text output module for MasterBASIC programs, in MBim format.
// http://programandala.net/en.program.wt.mbim.html
// Version A-00-20150204
// Copyright (C) 2014,2015 Marcos Cruz (programandala.net)
// License:
// http://programandala.net/license
// -------------------------------------------------------------
// History
// 2014-07-02: Conversion of the original tool written in X11-Basic
// (version A-00-20140212), with the help of
// x11-basic_to_mbim.vim, a little ad hoc tool written in Vim.
// 2014-07-22: Fix: typo in 'wtCls'.
// 2015-02-04: Some changes before publishing.
// -------------------------------------------------------------
// XXX TODO
// 2014-07-03:
// check and improve indentation
// check the coherence of wtCr and wtDoCr:
// wtCr should be mandatory, and wtDoCr can be removed
// 2014-03-31:
// scroll, pause
// -------------------------------------------------------------
// MBim's Vim preproc commands
#vim %substitute/\<UWRHS\>/\&5A38/gI
#vim %substitute/\<UWLHS\>/\&5A39/gI
#vim %substitute/\<UWTOP\>/\&5A3A/gI
#vim %substitute/\<UWBOT\>/\&5A3B/gI
// -------------------------------------------------------------
defproc wtInit
// Internal variables
let \
wtFreeCols=0,\
wtFreeRows=0
// Default values of the user variables
let \
wtPen=7,\
wtPaper=0,\
wtIndentation=2,\ // for the first line of a paragraph
wtSeparated=0 // blank line between paragraphs?
endproc
deffn wtRows=\
// Rows of the current upper window
peek UWBOT-peek UWTOP+1
deffn wtCols=\
// Columns of the current upper window
peek UWRHS-peek UWLHS+1
defproc wtPaper color
let wtPaper=color
endproc
defproc wtPen color
let wtPen=color
endproc
defproc wtHome
// Set the cursor at the top left position.
print at 0,0;:\
let \
wtFreeCols=fn wtCols,\
wtFreeRows=fn wtRows
endproc
defproc wtCls w
// Clear the screen (w=0) or the current window (w<>0)
// XXX TODO better
default w=1
cls w:\
wtHome
endproc
defproc wtWipe
// Wipe the screen with the current color.
// XXX TODO better
wtHome
wtLine(space$(fn wtRows*fn wtCols)) // paint the screen
wtHome
endproc
deffn wtAtFirstCol=\
// Is the cursor at the first column?
wtFreeCols=fn wtCols
deffn wtAtFirstRow=\
// Is the cursor at the first row?
wtFreeRows=fn wtRows
defproc wtDoCr
// Do a carriage return.
print
let \
wtFreeCols=fn wtCols,\
wtFreeRows=wtFreeRows-1
endproc
defproc wtCr
// Do a carriage return, if needed.
if not fn wtAtFirstCol then wtDoCr
endproc
defproc wtLine text$
// Print a text at the current cursor position; the text is not
// longer than the free space of the current row.
print paper wtPaper;pen wtPen;text$;
let wtFreeCols=wtFreeCols-len text$
endproc
defproc wtIndent
// Do a carriage return and indent.
wtCr
if not fn wtAtFirstRow then \
wtLine string$(wtIndentation," ")
endproc
defproc wt text$
// Print a text at the current cursor position.
local word$
if not len text$ then exit proc
do while text$(1)=" ":\
wtLine(" "):\
let text$=text$(2 to):\
loop
if text$(len text$)<>" " then \
let text$=text$+" "
do
let space=instr(1,text$," ")
if space
let \
word$=text$(to space-1),\
text$=text$(space+1 to)
else
let \
word$=text$,\
text$=""
endif
if wtFreeCols-1>=len word$
if not fn wtAtFirstCol
wtLine " "
endif
else
wtCr
endif
wtLine word$
loop until not len text$
endproc
defproc wt_ text$
// Print a text on a new line.
wtCr:\
wt text$
endproc
defproc wt__ text$
// Print a text on a new paragraph.
if wtSeparated then wtCr
wtIndent:\
wt text$
endproc
defproc wtS:\
renum line 50000 step 1
save over "wt":\
endproc