( The Bequest Globe )
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%DEBUG { ;print-hex JSR2 #0a .Console/write DEO }
%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO }
%RTN { JMP2r }
%FILE { #8000 }
%^s { FILE ;scat JSR2 }
%^c { FILE ;ccat JSR2 }
%^space { #20 ^c }
%^open { STH2 LIT '< ^c STH2r ^s LIT '> ^c }
%^close { STH2 LIT '< ^c LIT '/ ^c STH2r ^s LIT '> ^c }
%^wrap { STH2k ^open ^s STH2r ^close }
%GET-DEPTH { #0002 -- LDA ;chex JSR2 }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|a0 @File [ &vector $2 &success $2 &offset-hs $2 &offset-ls $2 &name $2 &length $2 &load $2 &save $2 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
|0000
( program )
|0100 ( -> )
( load file )
;tree/source .File/name DEO2
#4000 .File/length DEO2
;tree/data .File/load DEO2
.File/success DEI2 ;tree/length STA2
;tree/data
( remove linebreaks )
DUP2 #0a #00 ;cswp JSR2
;parse JSR2
( end )
#01 .System/debug DEO
#01 .System/halt DEO
BRK
@parse ( tree/data* -- )
&while
( move to name ) #0002 ++
( build ) DUP2 ;build-page JSR2
( move to eol ) DUP2 ;slen JSR2 ++ INC2
LDAk ,&while JCN
POP2
RTN
( ---------------------------------- )
@build-page ( name* -- )
( keep a copy )
#00 ;¤t STA
DUP2 ;¤t ;scpy JSR2
( create file )
#00 FILE STA
;doctype ^s
( create body )
;html-tag ^open
( head )
;build-page-head JSR2
( body )
;body-tag ^open
;build-page-header JSR2
;build-page-nav JSR2
;build-page-main JSR2
;build-page-footer JSR2
;body-tag ^close
;html-tag ^close
( save file )
;to-filepath JSR2 .File/name DEO2
FILE ;slen JSR2 .File/length DEO2
FILE .File/save DEO2
RTN
¤t $20
@build-page-head ( name* -- name* )
;head-tag ^open
;stylesheet-txt ;stylesheet-type ;stylesheet-path ;add-link-tag JSR2
;shortcuticon-txt ;shortcuticon-type ;shortcuticon-path ;add-link-tag JSR2
;title-tag ^open
;title ^s
^space
;mdash-entity-txt ^s
^space
DUP2 ^s
;title-tag ^close
;head-tag ^close
RTN
@build-page-header ( name* -- name* )
;header-tag ^open
;home-path ;add-a-tag JSR2
;logo-path ;logo-alt-txt ;add-img-tag JSR2
;a-tag ^close
;header-tag ^close
RTN
@build-page-nav ( name* -- name* )
;nav-tag ^open
DUP2 GET-DEPTH #00 = ,&no-siblings JCN
( parents )
DUP2 GET-DEPTH #02 < ,&no-parents JCN
DUP2 ;find-parent JSR2 ;find-parent JSR2 ,&children JSR POP2
&no-parents
( siblings )
DUP2 GET-DEPTH #01 < ,&no-siblings JCN
DUP2 ;find-parent JSR2 ,&children JSR POP2
&no-siblings
( children ) ,&children JSR
;nav-tag ^close
RTN
&children ( name* -- name* )
;ul-tag ^open
DUP2
( stash depth ) DUP2 GET-DEPTH STH
( start after ) DUP2 ;slen JSR2 ++ INC2
&while
( stop at sibling ) LDAk ;chex JSR2 STHkr = ,&end JCN
( when depth+1 ) LDAk ;chex JSR2 STHkr INC NEQ ,&continue JCN
;li-tag ^open
DUP2 #0002 ++ ;add-local JSR2
;li-tag ^close
&continue
( move to eol ) #0002 ++ DUP2 ;slen JSR2 ++ INC2
LDAk ,&while JCN
&end
POP2 POPr
;ul-tag ^close
RTN
@build-page-main ( name* -- name* )
;main-tag ^open
( create include path )
#00 ;buff STA
;input-path ;buff ;scpy JSR2
DUP2 ;buff ;scat JSR2
;htm-ext ;buff ;scat JSR2
;buff #20 LIT '_ ;cswp JSR2
( find include position )
FILE DUP2 ;slen JSR2 ++ STH2
( write body )
;buff .File/name DEO2
#4000 .File/length DEO2
STH2kr .File/load DEO2
( close )
#00 STH2r .File/success DEI2 ++ STA
;main-tag ^close
RTN
&include-path $30
@build-page-footer ( name* -- name* )
;footer-tag ^open
;creativecommon-path ;add-a-external-tag JSR2
;creativecommon-icon-path ;creativecommon-alt-txt ;add-img-tag JSR2
;a-tag ^close
;webring-path ;add-a-external-tag JSR2
;webring-icon-path ;webring-alt-txt ;add-img-tag JSR2
;a-tag ^close
;merveilles-path ;add-a-external-tag JSR2
;merveilles-icon-path ;merveilles-alt-txt ;add-img-tag JSR2
;a-tag ^close
;span-tag ^open
;devinelulinvega-path ;add-a-tag JSR2
;devinelulinvega-txt ^s
;a-tag ^close
^space
;copy-entity-txt ^s
^space
;year-txt ^s
^space
;mdash-entity-txt ^s
^space
;about-path ;add-a-tag JSR2
;license-txt ^s
;a-tag ^close
;span-tag ^close
;footer-tag ^close
RTN
( tools )
@find-term ( name* -- term* )
STH2
;tree/data
&while
( move to name ) #0002 ++
( test ) DUP2 STH2kr ;scmp JSR2 ,&end JCN
( move to eol ) DUP2 ;slen JSR2 ++ INC2
LDAk ,&while JCN
&end
POP2r
RTN
@find-parent ( term* -- parent* )
( rewind line )
#00 ;prev-char JSR2
( stash depth ) INC2k LDA ;chex JSR2 #01 - STH
;tree/data SWP2
&loop
#0001 -- #00 ;prev-char JSR2
INC2k LDA ;chex JSR2 STHkr ! ,&continue JCN
NIP2 POPr #0003 ++ RTN
&continue
LTH2k ,&loop JCN
POPr
#0002
RTN
( Web framework )
@add-a-tag ( path* -- )
STH2
LIT '< ^c
LIT 'a ^c
STH2r ;href-attr ;add-attr JSR2
LIT '> ^c
RTN
@add-a-external-tag ( path* -- )
STH2
LIT '< ^c
LIT 'a ^c
STH2r ;href-attr ;add-attr JSR2
;blank-target ;target-attr ;add-attr JSR2
LIT '> ^c
RTN
@add-img-tag ( src* alt* -- )
STH2 STH2
LIT '< ^c
;img-tag ^s
STH2r ;src-attr ;add-attr JSR2
STH2r ;alt-attr ;add-attr JSR2
LIT '/ ^c
LIT '> ^c
RTN
@add-link-tag ( rel* type* href* -- )
LIT '< ^c
;link-tag ^s
;href-attr ;add-attr JSR2
;type-attr ;add-attr JSR2
;rel-attr ;add-attr JSR2
LIT '/ ^c
LIT '> ^c
RTN
@add-attr ( attr* body* -- )
^space
^s
LIT '= ^c
LIT '" ^c
^s
LIT '" ^c
RTN
@add-local ( name* -- )
DUP2 ;build-page/current ;scmp JSR2 ,&no-link JCN
DUP2 ;to-filepath JSR2 ;add-a-tag JSR2 ^s ;a-tag ^close
RTN
&no-link
^s LIT '/ ^c
RTN
@to-filepath ( name* -- filepath* )
#00 ;buff STA
;output-path ;buff ;scpy JSR2
( name* ) ;buff ;scat JSR2
;html-ext ;buff ;scat JSR2
;buff #20 LIT '_ ;cswp JSR2
;buff
RTN
( generics )
@cswp ( string* a b -- )
STH STH
&while
LDAk STHkr NEQ ,&continue JCN
DUP2 OVRr STHr ROT ROT STA
&continue
INC2 LDAk ,&while JCN
POP2 POP2r
RTN
@prev-char ( addr* char -- addr* )
STH
&while
LDAk STHkr = ,&end JCN
LDAk #00 = ,&end JCN
#0001 -- LDAk ,&while JCN
&end
POPr
RTN
@next-char ( addr* char -- addr* )
STH
&while
LDAk STHkr = ,&end JCN
LDAk #00 = ,&end JCN
INC2 LDAk ,&while JCN
&end
POPr
RTN
( helpers )
@ccat ( char dst* -- )
#0001 --
&while
INC2 LDAk ,&while JCN
STH2k STA
#00 STH2r INC2 STA
RTN
@chex ( char -- hex )
DUPk #2f GTH SWP #3a LTH #0101 == ,&num JCN
DUPk #40 GTH SWP #47 LTH #0101 == ,&uca JCN
DUPk #60 GTH SWP #67 LTH #0101 == ,&lca JCN
POP #00 RTN
&num ( char -- hex )
LIT '0 - RTN
&uca ( char -- hex )
LIT 'A - #0a + RTN
&lca ( char -- hex )
LIT 'a - #0a + RTN
RTN
@scmp ( a* b* -- flag )
STH2
&loop
LDAk LDAkr STHr #0000 !! ,&continue JCN
POP2 POP2r #01 RTN
&continue
INC2 LDAk INC2r LDAkr STHr
EQU ,&loop JCN
POP2 POP2r #00
RTN
@scat ( src* dst* -- )
DUP2 ,slen JSR ++ ,scpy JSR
RTN
@scpy ( src* dst* -- )
STH2
DUP2
&while
SWP2k -- STH2kr ADD2 STH2
LDAk STH2r STA
INC2 LDAk ,&while JCN
SWP2 -- STH2r ADD2
#00 ROT ROT STA
RTN
@slen ( addr* -- length* )
#0001 -- DUP2
&while
INC2 LDAk ,&while JCN
SWP2 --
#0001 --
RTN
@print-hex ( value* -- )
STHk #04 SFT ,&parse JSR .Console/write DEO
STHr #0f AND ,&parse JSR .Console/write DEO
RTN
&parse ( value -- char )
DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN
RTN
@print-string ( addr* -- )
#0001 --
&loop
INC2 LDAk .Console/write DEO
LDAk ,&loop JCN
POP2
( linebreak ) #0a .Console/write DEO
RTN
@html-ext ".html $1
@htm-ext ".htm $1
@title "XXIIVV $1
@doctype "<!DOCTYPE 20 "html> $1
@html-tag "html $1
@head-tag "head $1
@title-tag "title $1
@body-tag "body $1
@header-tag "header $1
@nav-tag "nav $1
@main-tag "main $1
@footer-tag "footer $1
@h1-tag "h1 $1
@img-tag "img $1
@p-tag "p $1
@a-tag "a $1
@span-tag "span $1
@link-tag "link $1
@ul-tag "ul $1
@li-tag "li $1
@target-attr "target $1
@src-attr "src $1
@alt-attr "alt $1
@href-attr "href $1
@blank-target "_blank $1
@rel-attr "rel $1
@type-attr "type $1
@logo-alt-txt "XXIIVV $1
@header-txt "header $1
@year-txt "2021 $1
@index-path "../site-new/index.html $1
@input-path "content/ $1
@output-path "../site-new/ $1
@home-path "home.html $1
@logo-path "../media/icon/logo.svg $1
@hello-uxn-txt "Hello 20 "Uxn! $1
@stylesheet-txt "stylesheet $1
@stylesheet-type "text/css $1
@stylesheet-path "../links/main.css $1
@shortcuticon-txt "shortcut 20 "icon $1
@shortcuticon-type "image/png $1
@shortcuticon-path "../media/services/icon.png $1
@about-path "about.html $1
@license-txt "BY-NC-SA 20 "4.0 $1
@copy-entity-txt "© $1
@mdash-entity-txt "— $1
@devinelulinvega-path "devine_lu_linvega.html $1
@devinelulinvega-txt "Devine 20 "Lu 20 "Linvega $1
@creativecommon-path "https://creativecommons.org/licenses/by-nc-sa/4.0 $1
@creativecommon-icon-path "../media/icon/cc.svg $1
@creativecommon-alt-txt "CreativeCommons $1
@webring-path "http://webring.xxiivv.com/ $1
@webring-icon-path "../media/icon/webring.svg $1
@webring-alt-txt "Webring $1
@merveilles-path "https://merveilles.town/@neauoire $1
@merveilles-icon-path "../media/icon/merveilles.svg $1
@merveilles-alt-txt "Merveilles $1
@buff $100
( pad ) $1
@tree
&source "database/tree.tbtl $1
&length $2
&data