[Inquiry] Re: Theme One Program

[Jon Awbrey]

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o

TOP.  Note 3

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o

{ compiler: turbo pascal, version 5.0, }
{ (c) 1987, 1988 borland international }
{$M 53248,0,655360} { stack and heap   }
{$B+} { boolean complete evaluation on }

{ project: theme
  segment: learner + modeler                         copyright: 1984 - 2003
  version: 1                                                by: jon awbrey }

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o

function index (this: idea): idea;
var here, lex, lit: idea;

function diag (span: numb;
               this: idea): idea;
begin
 diag := at (span, span, this)
end;

function bias (that, this: idea): idea;
begin
 bias := diag (reck (that), this)
end;

function cant (this: idea): idea;
begin
 cant := diag (reck (this), this)
end;

function dent (that, this: idea): idea;
begin
 dent := diag (anon (reck (that)), this)
end;

function bent (that, this: idea): idea;
var span: numb;
begin
 span := anon (reck (that));
 bent := at (span, span + reck (this), this)
end;

function kern (that, this: idea): idea;
var here: idea;
begin
 kern := this;
 if this <> nil then
  if atom (this) <> nil then here := bent (that, this)
   else here := dent (this, this)
end;

function wash (size: numb;
         that, this: idea): idea;
var row, span: numb;
begin
 wash := this;
 span := reck (that);
 if atom (this) <> nil then this := dash (this)
  else for row := size downto span do this := dash (diag (row, this))
end;

function gnash (this: idea): idea;
begin
 gnash := dash (dent (this, nil))
end;

function fresh (tab: numb;
         that, this: idea): idea;
var span: numb;
begin
 span := reck (that);
 fresh := at (span, span + tab, this)
end;

function scion (this: idea): idea;
begin
 scion := graft (gist (this), splice)
end;

function split (this: idea): idea;
var here: idea;
begin
 here := nil;
 if cope (this) <> nil then
  here :=
   onset (scrip (this, links),
   onset (scrip (pend (this), right), this));
 split := here
end;

function scale (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if cope (that) <> nil then
  begin
   there := graft (split (that), splice);
   here := graft (stitch, graft (trip (that), this))
  end;
 scale := here
end;

function pod (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;
   there := fret (nigh (that));
   if there <> nil then
    here := upset (this, next (like (this, trip (there))));
   here := inset (this, anon (reck (that)))
  end;
 pod := here
end;

function note (that, this: idea): idea;
begin
 note := graft (that, pod (that, this))
end;

function clef (this: idea): idea;
begin
 clef := gauge (deal (nigh (this)))
end;

function plant (this: idea): idea;
var here: idea;
begin
 plant := this;
 if cleft (this) <> nil then
  begin
   here := this;
   repeat here := jolt (here)
    until here = nil
  end
end;

function reward (this: idea): idea;
begin
 reward := obvert (this, plant (nigh (this)))
end;

function place (this: idea): idea;
var here: idea;
begin
 place := this;
 if cleft (this) <> nil then
  begin
   here := this;
   repeat here := deal (jog (here))
    until here = nil
  end
end;

function credit (this: idea): idea;
begin
 credit := obvert (this, place (nigh (this)))
end;

function plait (that, this: idea): idea;
var here: idea;
begin
 here := nil;
 if lief (that) <> nil then
  here := graft (fore (last (trip (that))), this)
 else if cope (that) <> nil then here := scale (that, this);
 plait := here
end;

function plight (that, this: idea): idea;
var here: idea;
begin
 here := nil;
 if that <> nil then
  if this = nil then here := that
   else here := upset (this, plait (nigh (that), scion (this)));
 plight := here
end;

function pledge (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;
   repeat there := free (next (here));
    here := plight (here, there)
   until there = nil
  end;
 pledge := here
end;

function trunk (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if nigh (this) <> nil then here := this
   else if nigh (next (this)) <> nil then
    begin
     here := this;
     repeat here := next (here)
      until nigh (next (here)) = nil
    end;
 trunk := here
end;

function stash (this: idea): idea;
var here: idea;
begin
 stash := this;
 if this <> nil then
  begin
   here := trunk (this);
   if here <> this then here := pledge (here);
   here := credit (reward (here))
  end
end;

function stake (this: idea): idea;
var here: idea;
begin
 stake := this;
 if this <> nil then
  if rest (this) <> nil then here := pass (con, point, this)
   else here := claim (this)
end;

function spate (var thou: text;
                    this: idea): idea;
begin
 spate := spin (thou, space (thou, this))
end;

function ratio (var thou: text;
        thus, that, this: idea): idea;
var nom, num: numb;
begin
 ratio := this;
 nom := reck (thus);  num := reck (that);
 if nom > 0 then write (thou, num / nom :3:2)
end;

function log2 (what: real): real;
begin
 log2 := ln (what) / ln (2)
end;

function doubt (var thou: text;
        thus, that, this: idea): idea;
var nom, num: numb;
begin
 doubt := this;
 nom := reck (thus);  num := reck (that);
 if nom > 0 then if num > 0 then
  write (thou, (num / nom) * log2 (nom / num) :4:3)
end;

function spark (that, this: idea): idea;
begin
 spark := dash (spate (con, fresh (40, that, dash (this))))
end;

function glint (when, thus, that, this: idea): idea;
begin
 glint :=
  doubt (con, thus, that, fresh (60, when,
  ratio (con, thus, that, fresh (50, when, this))))
end;

function blaze (thus, that, this: idea): idea;
var here: idea;
begin
 blaze := this;
 if this <> nil then
  if atom (that) <> nil then here := part (con, gram (this))
   else if blur (this) <> nil then
    here :=
     glint (thus, nigh (that), this,
     spark (thus, stake (bias (thus, this))))
end;

function gloss (this: idea): idea;
var here, there: idea;
begin
 gloss := this;
 if this <> nil then
  if atom (this) <> nil then here := part (con, this)
   else if balk (this) <> nil then
    begin
     there := nigh (claim (cant (this)));
     here :=
      dent  (this,
      glint (this, stem (there), there,
      spark (this, there)))
    end
end;

function guess (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if that <> nil then
  begin
   here := tally (that);
   if this <> nil then
    begin
     there := this;
     repeat there := deal (there);
      if there <> nil then
       there := deal (blaze (jog (here), that, there))
     until there = nil
    end
  end;
 guess := here
end;

function trace (thus, that, this: idea): idea;
begin
 trace := kern (thus, wash (size, jog (guess (that, this)), that))
end;

function sketch (thus, that, this: idea): idea;
begin
 sketch := obvert (this, trace (thus, that, this))
end;

function glance (that, this: idea): idea;
begin
 glance := obvert (this, trace (that, this, nigh (this)))
end;

function flash (that, this: idea): idea;
begin
 flash := kern (that, vid (glance (that, dim (gloss (this)))))
end;

function reach (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := grasp (there)
   until (here <> nil) or (there = this)
  end;
 reach := here
end;

function pick (thus, that, this: idea): idea;
var here, there, where: idea;
begin
 here := nil;
 if lief (this) <> nil then
  begin
   here := this;
   there := trip (here);  where := nil;
   repeat
    here := sketch (thus, that, onset (here, reach (there)));
    there := trip (here);  where := tip
   until punt (where) = nil;
   if accept (where) <> nil then here := gauge (there) else here := nil
  end;
 pick := here
end;

function play (that, this: idea): idea;
begin
 play := vid (pick (that, this, dim (nigh (this))))
end;

function track (this: idea): idea;
var here: idea;
begin
 track := this;
 if this <> nil then
  begin
   here := this;
   repeat here := gloss (next (here))
    until here = this
  end
end;

function thrash (this: idea): idea;
begin
 thrash := kern (this, vid (glance (this, dim (track (this)))))
end;

function renumb (this: idea): idea;
var here: idea;
    span: numb;
begin
 renumb := this;
 if this <> nil then
  begin
   here := this;  span := 0;
   repeat here := next (inset (here, anew (span)))
    until here = this
  end
end;

function regard (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if bank (this) <> nil then
  begin
   there := axil (this);
   repeat here := graft (upset (gauge (there), next (there)), here);
    there := lead (there)
   until there = nil
  end;
 regard := here
end;

function review (this: idea): idea;
begin
 review := fore (renumb (next (regard (this))))
end;

function thresh (this: idea): idea;
var here, there, where, thus: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := ante (this);
   if there <> nil then
    repeat where := ante (there);
     here := thrash (review (where));  thus := tip;
     if entab (thus) <> nil then there := asset (there, trip (where))
    until entab (thus) = nil
  end;
 thresh := here
end;

function summary (this: idea): idea;
var thou: text;

function detail (var thou: text;
                      tab: numb;
        that, this: idea): idea;
begin
 detail :=
  return (thou,
   doubt (thou, that, this, skip (thou, 8,
   ratio (thou, that, this, skip (thou, 8,
   score (thou, 8,
   issue (thou, trim - tab, skip (thou, tab, this))))))))
end;

function report (var thou: text;
                      tab: numb;
                     this: idea): idea;
var here, there: idea;
begin
 report := this;
 if this <> nil then
  begin
   there := this;
   repeat
    if aspect (there) <> nil then
     here := detail (thou, tab, stem (this), there)
    else if lief (there) <> nil then
     here := report (thou, anon (tab), trip (there));
    there := next (there)
   until there = this
  end
end;

begin { summary }
 summary := compt (thou, report (thou, 0, clepe (thou, this)))
end;

function patch (this: idea): idea;
begin
 patch := call (at (24, 1, this))
end;

function catch (term, line: info;
                that, this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then if that <> nil then
  if match (that, buff (term)) = this then
   if prompt (line) <> nil then here := this;
 catch := here
end;

function pitch (menu, lit, this: idea): idea;
var here, thus, lex: idea;
begin
 here := nil;
 if this <> nil then if lit <> nil then
  begin
   thus := ante (this);  lex := fore (lit);
   if catch ('index', 'return to index', menu, thus) <> nil
    then here := flag
    else
     begin
      if catch ('sort', 'sort index', menu, thus) <> nil
       then here := wait (tort (resort (lex, lit, nil)))
      else if catch ('check', 'check memory', menu, thus) <> nil
       then here := hold (space (con, tort (check (nil))))
      else if catch ('summary', 'write summary file', menu, thus) <> nil
       then here := hold (graft (lex, summary (pinch (lit))))
      else if catch ('show', 'show index', menu, thus) <> nil
       then here := hold (turn (show (turn (stem (lit)))))
      else if catch ('dump', 'dump index', menu, thus) <> nil
       then here := hold (dump (turn (stem (lit))));
      here := nil
     end
  end;
 pitch := here
end;

function craft (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := flash (that, this);
   repeat there := tip;
    case arch (there) of
     escap, ender: here := nil;
     elide, erase,
     links, right: here := gnash (that);
     blank, enter: here := stash (glance (that, here));
     comma:        here := note (here, gloss (clef (here)));
     point:        here := note (here, gloss (play (that, here)))
     else          here := flash (that, note (here, token (there)))
    end
   until (accede (there) <> nil) or (here = nil)
  end;
 craft := here
end;

function effect (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat here := crest (there);
    there := deal (there)
   until (here <> nil) or (there = nil)
  end;
 effect := here
end;

function upshot (this: idea): idea;
begin
 upshot := effect (nigh (this))
end;

function nudge (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then here := nub (this);
 nudge := here
end;

function hint (thus, that, this: idea): idea;
begin
 hint := nudge (upshot (craft (thus, note (that, this))))
end;

function mote (thus, that, this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if lief (this) <> nil then
   begin
    here := dash (part (con, this));
    here := image (hint (thus, cue (that), token (tip)))
   end
  else here := hint (thus, cue (that), token (this));
 mote := here
end;

function draft (menu, lit, that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := flash (clear (nil), key (this));
   repeat there := tip;
    case arch (there) of
     enter: here := flash (nil, here);
     comma: here := gloss (note (here, clef (here)));
     point: here := gloss (note (here, play (nil, here)));
     estab: here := flash (nil, graft (key (this), thresh (here)));
     blank: here := pitch (menu, lit, patch (stash (glance (nil, here))));
     escap, ender, elide, erase, right: here := nil;
     else   here := flash (nil, note (here, mote (here, that, there)))
    end
   until (here = flag) or (here = nil)
  end;
  if scape (there) = nil then if here <> flag then here := this;
 draft := here
end;

begin { index }
 index := this;
 here := turn (nil);
 lit := stage (here);  lex := fore (lit);
 if lit <> nil then
  begin
   repeat
    repeat
     repeat here := draft (menu, lit, lex, lit)
      until here = nil;
     if permit ('sort index', clear (nil)) <> nil then
      here := turn (tort (resort (lex, lit, nil)))
    until prompt ('return to index') = nil;
    repeat here := draft (menu, lit, menu, venu)
     until (here = flag) or (here = nil);
   until here = clear (nil);
   repeat
    if prompt ('write lex file') <> nil then lex := save (pinch (lex));
    if prompt ('write lit file') <> nil then lit := save (pinch (lit))
   until prompt ('quit') <> nil
  end
end;

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o