Calendar with Custom Font

Date: 198x

Type: Program

Platform(s): TS 2068

Displays a full-screen calendar for one month, with the month name, year and dates printed in a large double-width custom font inside a ruled seven-column grid. Choose the month with a single key (1–9, 0, A, B), then the year: keys 1–0 select 1984 through 1993, and A lets you type any year from 1901 to 2043. The month and year are shown briefly on their own before the grid is drawn. To make another calendar, type RUN.

George Chambers’ notes for the disk describe it as a calendar that gives a full-screen display using an enlarged font. The font is a separate 2,464-byte CODE file, cale27.C1, loaded at 63064.

Program Analysis

Program Structure

Line 9980 is the autostart: it loads the font CODE block and then RUNs the program. Lines 150–290 take the month key and set A$; lines 300–410 map each month to C$, a six-character string that spells the three-letter month name in the custom font. Lines 450–830 take the year and build D$, E$ and F$, the century and the two final digits, each digit being a two-character pair. Lines 840–2100 work out the weekday offset, and lines 2110–3120 draw the grid and print the dates one week-row at a time.

Custom Font

The routine at line 120 sets the CHARS system variable (23606/7) to 62808, so character codes 32–127 come from the table at 63064; line 140 sets it back to the ROM font at 15360. Every piece of large text is printed with GO SUB 120 before and GO SUB 140 after. Each glyph is two character cells wide, so digits are pairs of codes: XY is 1, Z[ is 2, ] is 3, and so on up to hi for 9 and <= for 0. The CODE block runs to 65527, so it also loads the UDG area; UDG f is used as a filler between the date pairs.

Weekday Calculation

No formula is used. Lines 890–1720 are a series of FOR loops stepping by 28, the length of the Gregorian cycle within 1901–2099, and each loop compares the year against one position in that cycle. A match jumps to a line that sets a year offset XX; for leap years a separate value is used when the month is January or February. Lines 1980–2090 then add a fixed offset for each month to give X, a starting position from −5 to 1.

Drawing the Calendar

Two long DRAW statements (lines 2110–2120) rule the grid as a single connected path. Each week row is then printed as one precomputed 32-character string G$, chosen from seven alternatives by X, using OVER 1 so the digits do not wipe out the ruling. Days 29–31 are handled by month length: February is checked for a leap year with VAL B$-4*INT (VAL B$/4), and 31-day months print the final date at a column chosen by X (lines 2830–2980). When the month needs a sixth row, the cell is split with a diagonal line (PLOT 7,0: DRAW 14,14), the same way printed calendars put 24/31 in one box, and the overflow date goes in the lower corner using UDGs.

Notable Techniques

Switching the CHARS system variable to a RAM font for large text, and back to the ROM font for the day names.
Double-width digits built from pairs of character codes, so every date is a two-character string.
A 28-year lookup done with FOR loops instead of a day-of-week formula.
OVER 1 printing so text and the DRAWn grid lines overlap without erasing each other.
Split cells drawn with a diagonal line for months that would otherwise need a sixth week row.

Potential Issues

Line 2750 tests X=-4 a second time where X=-3 is meant. For a non-leap February starting at that offset, G$ keeps its previous value and the wrong row is printed on the last line.
Every calendar ends with a STOP, so the “STOP statement” report appears under the grid.
The year typed after pressing A gets only a rough check (line 615) before its characters are sliced. Input shorter than four characters causes a subscript error rather than a new prompt.
Lines 2130–2150 contain a leap-year label routine that has been left as REMs.

It comes from a Larken disk in the TS User Group’s collection (disk l-23). For this release it was converted to load and run from tape on a stock TS2068: the LKDOS PRINT USR 100 prefixes in front of the LOAD and SAVE lines were changed so the program and its font load from cassette. It was tested in ZEsarUX.

Appears On

SINCUS Exchange Tape 104

Music with pictures, printer utilities, drawing tools, games and home programs: over fifty programs from the SINCUS library tape that followed tape 103, rescued from disk.

Image Gallery

Source Code

  100 GO TO 130
  110 CLEAR 
  120 POKE 23606,88: POKE 23607,245: RETURN 
  130 POKE 23658,8: POKE 23606,0: POKE 23607,60: GO TO 150
  140 POKE 23606,0: POKE 23607,60: RETURN 
  150 PRINT "HIT KEY SHOWN FOR MONTH WANTED"
  160 PRINT ''"KEY","KEY"'" 1  JAN"," 7  JUL"''" 2  FEB"," 8  AUG"''" 3  MAR"," 9  SEP"''" 4  APR"," 0  OCT"''" 5  MAY"," A  NOV"''" 6  JUN"," B  DEC"
  165 PAUSE 0: IF INKEY$<"0" OR INKEY$>"B" THEN GO TO 165
  170 IF INKEY$="1" THEN LET A$="JAN"
  180 IF INKEY$="2" THEN LET A$="FEB"
  190 IF INKEY$="3" THEN LET A$="MAR"
  200 IF INKEY$="4" THEN LET A$="APR"
  210 IF INKEY$="5" THEN LET A$="MAY"
  220 IF INKEY$="6" THEN LET A$="JUN"
  230 IF INKEY$="7" THEN LET A$="JUL"
  240 IF INKEY$="8" THEN LET A$="AUG"
  250 IF INKEY$="9" THEN LET A$="SEP"
  260 IF INKEY$="0" THEN LET A$="OCT"
  270 IF INKEY$="A" THEN LET A$="NOV"
  280 IF INKEY$="B" THEN LET A$="DEC"
  290 GO SUB 300: GO TO 450
  300 IF A$="JAN" THEN LET C$="23 !:;"
  310 IF A$="FEB" THEN LET C$="*+()""#"
  320 IF A$="MAR" THEN LET C$="89 !BC"
  330 IF A$="APR" THEN LET C$=" !>?BC"
  340 IF A$="MAY" THEN LET C$="89 !PQ"
  350 IF A$="JUN" THEN LET C$="23HI:;"
  360 IF A$="JUL" THEN LET C$="23HI67"
  370 IF A$="AUG" THEN LET C$=" !HI,-"
  380 IF A$="SEP" THEN LET C$="DE()>?"
  390 IF A$="OCT" THEN LET C$="<=$%FG"
  400 IF A$="NOV" THEN LET C$=":;<=JK"
  410 IF A$="DEC" THEN LET C$="&'()$%"
  420 CLS : PRINT AT 16,0;"MONTH": GO SUB 120: OVER 1: PRINT AT 16,7;C$: OVER 0: GO SUB 140
  430 PAUSE 90
  440 RETURN 
  450 CLS : PRINT "HIT KEY FOR YEAR WANTED."''"FOR YEARS NOT SHOWN HIT KEY A." 
  460 PRINT ''"KEY","KEY"'" 1  1984"," 6  1989"''" 2  1985"," 7  1990"''" 3  1986"," 8  1991"''" 4  1987"," 9  1992"''" 5  1988"," 0  1993"
  470 PRINT '''''"AFTER CALENDAR IS PRINTED USE   RUN AND ENTER TO START AGAIN"
  480 PAUSE 0: IF INKEY$<"0" OR INKEY$>"A" THEN GO TO 480
  490 IF INKEY$="1" THEN LET B$="1984"
  500 IF INKEY$="2" THEN LET B$="1985"
  510 IF INKEY$="3" THEN LET B$="1986"
  520 IF INKEY$="4" THEN LET B$="1987"
  530 IF INKEY$="5" THEN LET B$="1988"
  540 IF INKEY$="6" THEN LET B$="1989"
  550 IF INKEY$="7" THEN LET B$="1990"
  560 IF INKEY$="8" THEN LET B$="1991"
  570 IF INKEY$="9" THEN LET B$="1992"
  580 IF INKEY$="0" THEN LET B$="1993"
  590 IF INKEY$="A" THEN GO TO 610
  600 GO SUB 620: IF VAL B$>0 THEN GO TO 840
  610 CLS : PRINT AT 0,0;"INPUT YEAR ";''"ANY YEAR FROM 1901 TO 2043   ": INPUT B$
  615 IF B$<"0" OR B$>"A" THEN GO TO 610
  617 GO SUB 620: GO TO 840
  620 IF B$(1 TO 2)="19" THEN LET D$="XYhi"
  630 IF B$(1 TO 2)="20" THEN LET D$="Z[<="
  640 IF B$(3)="1" THEN LET E$="XY"
  650 IF B$(3)="2" THEN LET E$="Z["
  660 IF B$(3)="3" THEN LET E$="\]"
  670 IF B$(3)="4" THEN LET E$="^_"
  680 IF B$(3)="5" THEN LET E$="`a"
  690 IF B$(3)="6" THEN LET E$="bc"
  700 IF B$(3)="7" THEN LET E$="de"
  710 IF B$(3)="8" THEN LET E$="fg"
  720 IF B$(3)="9" THEN LET E$="hi"
  730 IF B$(3)="0" THEN LET E$="<="
  740 IF B$(4)="1" THEN LET F$="XY"
  750 IF B$(4)="2" THEN LET F$="Z["
  760 IF B$(4)="3" THEN LET F$="\]"
  770 IF B$(4)="4" THEN LET F$="^_"
  780 IF B$(4)="5" THEN LET F$="`a"
  790 IF B$(4)="6" THEN LET F$="bc"
  800 IF B$(4)="7" THEN LET F$="de"
  810 IF B$(4)="8" THEN LET F$="fg"
  820 IF B$(4)="9" THEN LET F$="hi"
  830 IF B$(4)="0" THEN LET F$="<="
  840 CLS : PRINT AT 16,0;"MONTH": GO SUB 120: OVER 1: PRINT AT 16,7;C$: OVER 0: GO SUB 140
  850 PRINT AT 18,0;"YEAR": GO SUB 120: PRINT AT 18,6;D$;E$;F$: GO SUB 140:
  860 PAUSE 90: CLS 
  870 IF VAL B$>2043 THEN GO TO 610
  880 IF VAL B$<1901 THEN GO TO 610
  890 FOR N=1920 TO 2032 STEP 28
  900 IF VAL B$=N THEN GO TO 1730
  910 NEXT N
  920 FOR N=1925 TO 2037 STEP 28
  930 IF VAL B$=N THEN GO TO 1730
  940 NEXT N
  950 FOR N=1903 TO 2043 STEP 28
  960 IF VAL B$=N THEN GO TO 1730
  970 NEXT N
  980 FOR N=1914 TO 2026 STEP 28
  990 IF VAL B$=N THEN GO TO 1730
 1000 NEXT N
 1010 FOR N=1921 TO 2033 STEP 28
 1020 IF VAL B$=N THEN GO TO 1750
 1030 NEXT N
 1040 FOR N=1922 TO 2034 STEP 28
 1050 IF VAL B$=N THEN GO TO 1760
 1060 NEXT N
 1070 FOR N=1923 TO 2035 STEP 28
 1080 IF VAL B$=N THEN GO TO 1770
 1090 NEXT N
 1100 FOR N=1924 TO 2036 STEP 28
 1110 IF VAL B$=N THEN GO TO 1800
 1120 NEXT N
 1130 FOR N=1926 TO 2038 STEP 28
 1140 IF VAL B$=N THEN GO TO 1740
 1150 NEXT N
 1160 FOR N=1927 TO 2039 STEP 28
 1170 IF VAL B$=N THEN GO TO 1750
 1180 NEXT N
 1190 FOR N=1928 TO 2040 STEP 28
 1200 IF VAL B$=N THEN GO TO 1830
 1210 NEXT N
 1220 FOR N=1901 TO 2041 STEP 28
 1230 IF VAL B$=N THEN GO TO 1780
 1240 NEXT N
 1250 FOR N=1902 TO 2042 STEP 28
 1260 IF VAL B$=N THEN GO TO 1790
 1270 NEXT N
 1280 FOR N=1904 TO 2016 STEP 28
 1290 IF VAL B$=N THEN GO TO 1860
 1300 NEXT N
 1310 FOR N=1905 TO 2017 STEP 28
 1320 IF VAL B$=N THEN GO TO 1760
 1330 NEXT N
 1340 FOR N=1906 TO 2018 STEP 28
 1350 IF VAL B$=N THEN GO TO 1770
 1360 NEXT N
 1370 FOR N=1907 TO 2019 STEP 28
 1380 IF VAL B$=N THEN GO TO 1780
 1390 NEXT N
 1400 FOR N=1908 TO 2020 STEP 28
 1410 IF VAL B$=N THEN GO TO 1890
 1420 NEXT N
 1430 FOR N=1909 TO 2021 STEP 28
 1440 IF VAL B$=N THEN GO TO 1740
 1450 NEXT N
 1460 FOR N=1910 TO 2022 STEP 28
 1470 IF VAL B$=N THEN GO TO 1750
 1480 NEXT N
 1490 FOR N=1911 TO 2023 STEP 28
 1500 IF VAL B$=N THEN GO TO 1770
 1510 NEXT N
 1520 FOR N=1912 TO 2024 STEP 28
 1530 IF VAL B$=N THEN GO TO 1920
 1540 NEXT N
 1550 FOR N=1913 TO 2025 STEP 28
 1560 IF VAL B$=N THEN GO TO 1790
 1570 NEXT N
 1580 FOR N=1915 TO 2027 STEP 28
 1590 IF VAL B$=N THEN GO TO 1740
 1600 NEXT N
 1610 FOR N=1916 TO 2028 STEP 28
 1620 IF VAL B$=N THEN GO TO 1950
 1630 NEXT N
 1640 FOR N=1917 TO 2029 STEP 28
 1650 IF VAL B$=N THEN GO TO 1770
 1660 NEXT N
 1670 FOR N=1918 TO 2030 STEP 28
 1680 IF VAL B$=N THEN GO TO 1780
 1690 NEXT N
 1700 FOR N=1919 TO 2031 STEP 28
 1710 IF VAL B$=N THEN GO TO 1790
 1720 NEXT N
 1730 LET XX=0: GO TO 1980
 1740 LET XX=-1: GO TO 1980
 1750 LET XX=-2: GO TO 1980
 1760 LET XX=-3: GO TO 1980
 1770 LET XX=-4: GO TO 1980
 1780 LET XX=-5: GO TO 1980
 1790 LET XX=-6: GO TO 1980
 1800 LET XX=-6
 1810 IF A$="JAN" OR A$="FEB" THEN LET XX=-5
 1820 GO TO 1980
 1830 LET XX=-4
 1840 IF A$="JAN" OR A$="FEB" THEN LET XX=-3
 1850 GO TO 1980
 1860 LET XX=-2
 1870 IF A$="JAN" OR A$="FEB" THEN LET XX=-1
 1880 GO TO 1980
 1890 LET XX=0
 1900 IF A$="JAN" OR A$="FEB" THEN LET XX=-6
 1910 GO TO 1980
 1920 LET XX=-5
 1930 IF A$="JAN" OR A$="FEB" THEN LET XX=-4
 1940 GO TO 1980
 1950 LET XX=-3
 1960 IF A$="JAN" OR A$="FEB" THEN LET XX=-2
 1970 GO TO 1980
 1980 IF A$="JAN" THEN LET X=XX+-3
 1990 IF A$="FEB" THEN LET X=XX+1
 2000 IF A$="MAR" THEN LET X=XX+1
 2010 IF A$="APR" THEN LET X=XX+-2
 2020 IF A$="MAY" THEN LET X=XX+-4
 2030 IF A$="JUN" THEN LET X=XX+0
 2040 IF A$="JUL" THEN LET X=XX+-2
 2050 IF A$="AUG" THEN LET X=XX+-5
 2060 IF A$="SEP" THEN LET X=XX+-1
 2070 IF A$="OCT" THEN LET X=XX+-3
 2080 IF A$="NOV" THEN LET X=XX+1
 2090 IF A$="DEC" THEN LET X=XX+-1
 2100 IF X<-5 THEN LET X=X+7
 2110 DRAW 255,0: DRAW 0,29: DRAW -255,0: DRAW 0,30: DRAW 255,0: DRAW 0,29: DRAW -255,0: DRAW 0,29: DRAW 255,0: DRAW 0,30: DRAW -255,0: DRAW 0,28: DRAW 255,0
 2120 DRAW 0,-175: DRAW -37,0: DRAW 0,147: DRAW -36,0: DRAW 0,-147: DRAW -37,0: DRAW 0,147: DRAW -36,0: DRAW 0,-147: DRAW -37,0: DRAW 0,147: DRAW -36,0: DRAW 0,-147: DRAW -36,0: DRAW 0,147
 2130 REM IF VAL B$-4*INT (VAL B$/4)=0 THEN GO TO 717
 2140 REM IF VAL B$-4*INT (VAL B$/4)<>0 THEN GO TO 720
 2150 REM OVER 1: PRINT AT 1,20;" (LEAP YEAR)": OVER 0
 2160 OVER 1: GO SUB 120: PRINT AT 1,0;C$;"f";D$;E$;F$: GO SUB 140: PRINT AT 2,0;"Sun";AT 2,5;"Mon";AT 2,10;"Tue";AT 2,14;"Wed";AT 2,19;"Thu";AT 2,23;"Fri";AT 2,28;"Sat": OVER 0
 2170 IF X=-5 THEN LET G$="ffffffffffffffffffffffffffffXY"
 2180 IF X=-4 THEN LET G$="fffffffffffffffffffffffXYfffZ["
 2190 IF X=-3 THEN LET G$="ffffffffffffffffffXYfffZ[fff\]"
 2200 IF X=-2 THEN LET G$="ffffffffffffffXYffZ[fff\]fff^_"
 2210 IF X=-1 THEN LET G$="fffffffffXYfffZ[ff\]fff^_fff`a"
 2220 IF X=0 THEN LET G$="fffffXYffZ[fff\]ff^_fff`afffbc"
 2230 IF X=1 THEN LET G$="XYfffZ[ff\]fff^_ff`afffbcfffde"
 2240 GO SUB 120: OVER 1: PRINT AT 5,0;G$: OVER 0: GO SUB 140
 2250 IF X=-5 THEN LET G$="Z[fff\]ff^_fff`affbcfffdeffffg"
 2260 IF X=-4 THEN LET G$="\]fff^_ff`afffbcffdeffffgfffhi"
 2270 IF X=-3 THEN LET G$="^_fff`affbcfffdefffgfffhifffXY<="
 2280 IF X=-2 THEN LET G$="`afffbcffdeffffgffhifffXY<=fXYXYf"
 2290 IF X=-1 THEN LET G$="bcff  defffgfffhiffXY<=fXYXYfXYZ["
 2300 IF X=0 THEN LET G$="deffffgffhifffXY<=XYXYfXYZ[fXY\]"
 2310 IF X=1 THEN LET G$="fgfffhiffXY<=fXYXYXYZ[fXY\]fXY^_"
 2320 GO SUB 120: OVER 1: PRINT AT 9,0;G$: OVER 0: GO SUB 140
 2330 GO TO 2400
 2340 IF A$="FEB" AND VAL B$-4*INT (VAL B$/4)=0 THEN GO TO 2650
 2350 IF A$="FEB" AND VAL B$-4*INT (VAL B$/4)<>0 THEN GO TO 2730
 2360 IF A$<>"FEB" THEN GO TO 2570
 2370 IF A$="FEB" THEN STOP 
 2380 IF A$="FEB" THEN STOP 
 2390 GO TO 2810
 2400 IF X=-5 THEN LET G$="hifffXY<=XYXYfXYZ[XY\]fXY^_fXY`a"
 2410 IF X=-4 THEN LET G$="XY<=fXYXYXYZ[fXY\]XY^_fXY`afXYbc"
 2420 IF X=-3 THEN LET G$="XYXYfXYZ[XY\]fXY^_XY`afXYbcfXYde"
 2430 IF X=-2 THEN LET G$="XYZ[fXY\]XY^_fXY`aXYbcfXYdefXYfg"
 2440 IF X=-1 THEN LET G$="XY\]fXY^_XY`afXYbcXYdefXYfgfXYhi"
 2450 IF X=0 THEN LET G$="XY^_fXY`aXYbcfXYdeXYfgfXYhifZ[<="
 2460 IF X=1 THEN LET G$="XY`afXYbcXYdefXYfgXYhifZ[<=fZ[XY"
 2470 GO SUB 120: OVER 1: PRINT AT 12,0;G$: OVER 0: GO SUB 140
 2480 IF X=-5 THEN LET G$="XYbcfXYdeXYfgfXYhiZ[<=fZ[XYfZ[Z["
 2490 IF X=-4 THEN LET G$="XYdefXYfgXYhifZ[<=Z[XYfZ[Z[fZ[\]"
 2500 IF X=-3 THEN LET G$="XYfgfXYhiZ[<=fZ[XYZ[Z[fZ[\]fZ[^_"
 2510 IF X=-2 THEN LET G$="XYhifZ[<=Z[XYfZ[Z[Z[\]fZ[^_fZ[`a"
 2520 IF X=-1 THEN LET G$="Z[<=fZ[XYZ[Z[fZ[\]Z[^_fZ[`afZ[bc"
 2530 IF X=0 THEN LET G$="Z[XYfZ[Z[Z[\]fZ[^_Z[`afZ[bcfZ[de"
 2540 IF X=1 THEN LET G$="Z[Z[fZ[\]Z[^_fZ[`aZ[bcfZ[defZ[fg"
 2550 GO SUB 120: OVER 1: PRINT AT 16,0;G$: OVER 0: GO SUB 140
 2560 IF A$="FEB" THEN GO TO 2340
 2570 IF X=-5 THEN LET G$="Z[\]fZ[^_Z[`afZ[bcZ[defZ[fgfZ[hi"
 2580 IF X=-4 THEN LET G$="Z[^_fZ[`aZ[bcfZ[deZ[fgfZ[hif\]<="
 2590 IF X=-3 THEN LET G$="Z[`afZ[bcZ[defZ[fgZ[hif\]<="
 2600 IF X=-2 THEN LET G$="Z[bcfZ[deZ[fgfZ[hi\]<="
 2610 IF X=-1 THEN LET G$="Z[defZ[fgZ[hif\]<="
 2620 IF X=0 THEN LET G$="Z[fgfZ[hi\]<="
 2630 IF X=1 THEN LET G$="Z[hif\]<="
 2640 GO SUB 120: OVER 1: PRINT AT 19,0;G$: OVER 0: GO SUB 140: GO TO 2370
 2650 IF X=-5 THEN LET G$="Z[\]fZ[^_Z[`afZ[bcZ[defZ[fgfZ[hi"
 2660 IF X=-4 THEN LET G$="Z[^_fZ[`aZ[bcfZ[deZ[fgfZ[hi"
 2670 IF X=-3 THEN LET G$="Z[`afZ[bcZ[defZ[fgfZ[hi"
 2680 IF X=-2 THEN LET G$="Z[bcfZ[deZ[fgfZ[hi"
 2690 IF X=-1 THEN LET G$="Z[defZ[fgZ[hi"
 2700 IF X=0 THEN LET G$="Z[fgfZ[hi"
 2710 IF X=1 THEN LET G$="Z[hi"
 2720 GO SUB 120: OVER 1: PRINT AT 19,0;G$: OVER 0: GO SUB 140: GO TO 2370
 2730 IF X=-5 THEN LET G$="Z[\]fZ[^_Z[`afZ[bcZ[defZ[fg"
 2740 IF X=-4 THEN LET G$="Z[^_fZ[`aZ[bcfZ[defZ[fg"
 2750 IF X=-4 THEN LET G$="Z[`afZ[bcZ[defZ[fg"
 2760 IF X=-2 THEN LET G$="Z[bcfZ[deZ[fg"
 2770 IF X=-1 THEN LET G$="Z[defZ[fg"
 2780 IF X=0 THEN LET G$="Z[fg"
 2790 IF X=1 THEN LET G$="f"
 2800 GO SUB 120: OVER 1: PRINT AT 19,0;G$: OVER 0: GO SUB 140: STOP : GO TO 2370
 2810 IF A$="JAN" OR A$="MAR" OR A$="MAY" OR A$="JUL" OR A$="AUG" OR A$="OCT" OR A$="DEC" THEN GO TO 2830
 2820 IF A$="APR" OR A$="JUN" OR A$="SEP" OR A$="NOV" THEN GO TO 2990
 2830 IF X=1 THEN GO TO 2900
 2840 IF X=0 THEN GO TO 2920
 2850 IF X=-1 THEN GO TO 2930
 2860 IF X=-2 THEN GO TO 2940
 2870 IF X=-3 THEN GO TO 2950
 2880 IF X=-4 THEN GO TO 2960
 2890 IF X=-5 THEN GO TO 2970
 2900 REM OVER 1: GO SUB 15: PRINT AT 10,0;"a";AT 19,9;"\]XY": GO SUB 26: OVER 0
 2910 OVER 1: GO SUB 120: PRINT AT 19,9;"\]XY": GO SUB 140: OVER 0: STOP 
 2920 OVER 1: GO SUB 120: PRINT AT 19,14;"\]XY": GO SUB 140: OVER 0: STOP 
 2930 OVER 1: GO SUB 120: PRINT AT 19,18;"\]XY": GO SUB 140: OVER 0: STOP 
 2940 OVER 1: GO SUB 120: PRINT AT 19,23;"\]XY": GO SUB 140: OVER 0: STOP 
 2950 OVER 1: GO SUB 120: PRINT AT 19,28;"\]XY": OVER 0: GO SUB 140: STOP 
 2960 GO SUB 120: OVER 1: PRINT AT 21,2;"rt": OVER 0: GO SUB 140: PLOT 7,0: DRAW 14,14: STOP 
 2970 PLOT 7,0: DRAW 14,14: PLOT 43,0: DRAW 14,14
 2980 OVER 1: PRINT AT 21,2;"rs";AT 21,6;"rt": OVER 0: STOP 
 2990 IF X=-5 THEN GO TO 3120
 3000 IF X=-4 THEN GO TO 3110
 3010 IF X=-3 THEN GO TO 3100
 3020 IF X=-2 THEN GO TO 3090
 3030 IF X=-1 THEN GO TO 3080
 3040 IF X=0 THEN GO TO 3070
 3050 IF X=1 THEN GO TO 3060
 3060 GO SUB 120: PRINT AT 19,5;"\]<=": GO SUB 140: STOP 
 3070 STOP : GO SUB 120: PRINT AT 19,9;"\]<=": GO SUB 140: STOP 
 3080 GO SUB 120: PRINT AT 19,14;"\]<=": GO SUB 140: STOP 
 3090 STOP : GO SUB 120: PRINT AT 19,19;"\]<=": GO SUB 140: STOP 
 3100 GO SUB 120: PRINT AT 19,23;"\]<=": GO SUB 140: STOP 
 3110 STOP : GO SUB 120: OVER 1: PRINT AT 19,28;"\]<=": OVER 0: GO SUB 140: STOP 
 3120 GO SUB 120: OVER 1: PRINT AT 21,2;"rs": GO SUB 140: PLOT 7,0: DRAW 14,14: OVER 0: STOP 
 9980 PRINT USR 100: LOAD "cale27.C1"CODE 
 9981 RUN 
 9989 STOP 
 9990 PRINT USR 100: SAVE "cale27.B1" LINE 9980
 9991 PRINT USR 100: SAVE "cale27.C1"CODE 63064,2464

Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.