-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy path0006-Text-Objects.st
1103 lines (1017 loc) · 34.3 KB
/
0006-Text-Objects.st
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
'From Smalltalk 5.5k XM November 24 on 22 November 1980 at 2:57:08 am.'
"Dispframe"
Class new title: 'Dispframe'
subclassof: Stream
fields: 'text'
declare: 'prompt doit ';
asFollows
I am a dialog window
Initialization
classInit [prompt ← ''◦1. doit ← ' '◦1]
frame ← r
[text para: nil frame: r]
init
[text ← Textframe new.
self of: (String new: 16)]
rect: r
[self init; frame ← r; clear]
Scheduler
eachtime | t
[text window has: user mp⇒
[user kbck⇒[t← self kbd⇒
[ [t≡nil⇒[] self space; print: nilⓢ t].
self prompt]]
user bluebug⇒ [⇑false]]
user anybug⇒[⇑false]]
firsttime
[text window has: user mp⇒
[self outline; prompt]
⇑false]
lasttime
[ [self last=prompt⇒[self skip: ¬2; show]].
⇑user bluebug≡false]
leave
Dialog
ev | t
[while⦂ [self cr. t ← self request: ''] do⦂
[self space; print: nil ⓢt]
⇑false]
kbd | n t "false if user pauses, nil if ctrl-d, all input since prompt if "
[while⦂ user kbck do⦂
[t ← user kbd.
t=132⇒ [self append: 'done.'; show. ⇑nil]; "ctl-d for done"
=8⇒ [self last=prompt⇒[] self skip: ¬1]; "backspace"
=30⇒ [n ← array◦(position to: 1 by:¬1) find: prompt.
n=0⇒[self append: 'lost beginning'; prompt]
t← self last: n-1. self next← doit; show. ⇑t]; "do-it (LF)"
=145⇒ [self last=prompt⇒[] self skip: ¬1. "ctl-w for backspace word"
while⦂ (position>0 and: self last tokenish) do⦂ [self skip: ¬1]];
=151⇒[self reset; prompt] "ctl-x clears frame"
self next ← t]
self show. ⇑false]
prompt [self cr; next← prompt; show]
read | t "false if ctrl-d, all input since prompt if "
[self next← prompt; show.
until⦂ [user kbck⇒[t← self kbd] false] do⦂ []
t≡nil⇒[⇑false] ⇑t]
request: s "false if ctrl-d, all input since prompt if "
[self append: s. ⇑self read]
Image
clear
[self reset. self show]
moveto: pt
[(text window inset: ¬2⌾¬2) dragto: pt-(¬2⌾¬2)]
outline
[text window outline: 2]
show | t [
text show: self contents.
until⦂ text lastshown≥ position do⦂ [
position < (t ← text scrolln: 1)⇒ []
t ← array copy: t+1 to: position.
text show: t.
position ← 0.
self append: t.
"self dequeue: (text scrolln: 1).
text show: self contents"]]
Access to Parts
frame
[⇑text frame]
text
[⇑text]
SystemOrganization classify: ↪Dispframe under: 'Text Objects'.
Dispframe classInit
"Paragraph"
Class new title: 'Paragraph'
subclassof: Array
fields: 'text runs alignment'
declare: '';
asFollows
Paragraphs implement pretty text.
text is a String of the ascii characters.
alignment specifies how the paragraph should be justified.
runs is a String of run-coded format information.
odd byte is run length (≤255)
following byte is 16*format number +
1*bold 2*italic 4*underline 8*strikeout
longer runs are made from several of length 255.
Initialization of parts
copy [⇑self class new text: text runs: runs alignment: alignment]
text: text
[alignment ← 0]
text: text alignment: alignment
text: text runs: runs alignment: alignment
Normal access
◦x [⇑text◦x]
asParagraph [⇑self]
asStream [⇑text asStream]
asVector [⇑text asVector]
copy: a to: b "Return a copied subrange of this paragraph"
[⇑self class new
text: (text copy: a to: b)
runs: (self run: a to: b)
alignment: alignment]
findString: str startingAt: start
[⇑text findString: str startingAt: start]
length [⇑text length]
replace: a to: b by: c ["alters self - doesnt copy"
[runs≡nil and⦂ (c isnt: self class)⇒[]
runs ← self runcat: (self run: 1 to: a-1)
and: [c is: self class⇒ [c runs]
self makerun: c length val: [
runs empty⇒[0]
runs◦((self runfind: b)◦1+1)]]
and: (self run: b+1 to: text length)].
text ← text replace: a to: b by: [c is: self class⇒[c text] c]]
subst: x for: y "runs are not supported yet here"
[⇑text subst: x for: y]
text [⇑text]
textStyle [⇑DefaultTextStyle]
Text alignment
alignment [⇑alignment]
alignment ← alignment
center [alignment ← 2]
flushleft [alignment ← 0]
flushright [alignment ← 4]
justify [alignment ← 1]
Manipulation of format runs
allBold [self maskrunsunder: 1 to: 1]
allFont: n [
[n is: String⇒ [n ← (self textStyle fontnames find: n) - 1]].
self maskrunsunder: 0360 to: n*16]
allItalic [self maskrunsunder: 2 to: 2]
makeBoldPattern | s i c
[s ← text asStream. i← 0.
until⦂ [c← s next⇒ " scan to bracket, bar or comment "
[c=91⇒[true]; =124⇒[true]; =34⇒[true]; =25⇒[true] false]
true] "end"
do⦂ [i← i+1].
self maskrun: 1 to: i under: 1 to: 1]
makerun: len val: val "Make up a solid run of value val"
| str i
[len=0⇒[⇑nullString]
str ← String new: len-1/255+1*2.
for⦂ i from: 1 to: str length by: 2 do⦂ [
str◦i ← [len>255⇒[255] len].
str◦(i+1) ← val.
len ← len-255].
⇑str]
maskrun: i to: j under: m to: val "Alter my runs so that the bits selected by m become val."
| r k "Maybe merge this with mergestyle"
[r ← self run: i to: j.
for⦂ k from: 2 to: r length by: 2 do⦂
[r◦k ← (r◦k land: 0377-m) + val].
runs ← self runcat: (self run: 1 to: i-1) and: r and: (self run: j+1 to: text length)]
maskrunsunder: m to: val
[self maskrun: 1 to: text length under: m to: val]
run: a to: b | c "subrange of run"
[a>b⇒[⇑nullString]
runs≡nil⇒[⇑self makerun: 1+b-a val: 0]
a ← self runfind: a.
b ← self runfind: b.
c ← runs copy: a◦1 to: b◦1+1. "copy the sub-run"
[(a◦1)=(b◦1)⇒
[c◦1 ← 1+ (b◦2)-(a◦2)]
c◦1 ← 1+(runs◦(a◦1))- (a◦2). "trim the end lengths"
c◦(c length-1) ← b◦2].
⇑c]
runcat: r1 and: r2 and: r3 | i r olen len oc c nr [
"concatenate and compact 3 runs"
nr ← Stream new of: (String new: 30).
oc ← false.
for⦂ i to: 3 do⦂ [
r ← [i=1⇒ [r1]; =2⇒ [r2] r3].
r length=0⇒ []
r ← r asStream.
while⦂ (len ← r next) do⦂ [
c ← r next.
len = 0⇒ ["ignore empty runs (shouldn't be any)"]
oc = c⇒ [
(olen ← olen+len) ≤ 255⇒ []
nr next ← 255; next ← oc.
olen ← olen-255]
[oc⇒ [nr next ← olen; next ← oc] "first time thru"].
olen ← len. oc ← c]].
[oc⇒ [
"leftovers"
nr next ← olen; next ← oc]].
⇑nr contents]
runcat: x to: y [⇑self runcat: x and: y and: '']
runfind: index | run t "index into run"
[run←1.
while⦂ (t ← index - (runs◦run)) > 0 do⦂
[index ← t. run ← run+2].
⇑run,index]
runs "return runs or default if none"
[runs≡nil⇒[⇑self makerun: text length val: 0]
⇑runs]
Bravo conversions
applyBravo: s at: i to: j | v ch t bslash cr [
"Alter runs of characters i through j according to trailer.
see Ibis<Bravo>Trailer.Memo for further info.
some functions may not be implemented, thus parsed and ignored.
paragraph looks.
implemented: justification (j), centering (c).
ignored: left margin (l), first line left margin (d), right margin (z),
line leading (x), paragraph leading (e), vertical tab (y), keep (k), profile (q),
tab tables ( () )"
s ← s asStream.
cr ← 015.
bslash ← '\'◦1.
until⦂ (ch ← s next) = bslash do⦂ [
ch ≡ false or⦂ ch = cr⇒ ["no more" ⇑self]
(t ← 'jcq' find: ch) > 0⇒ [
t=1⇒ [self justify]; =2⇒ [self center]]
(t ← '(ldzxeyk' find: ch) > 0⇒ [
t=1⇒ [s skipTo: ')'◦1]
s integerScan]
].
"character looks.
implemented: font (f), bold (bB), italic (iI), underline (uU).
ignored: graphic (g), visible (v), overstrike (s), superscript (o), tabcolor (t)"
while⦂ ((ch ← s next) and⦂ ch ≠ cr) do⦂ [
"run length"
[ch ≥ 060 and⦂ ch ≤ 071 "isdigit"⇒ [s skip: ¬1] ch = 040]⇒ [
i ← i + s integerScan]
(t ← 'bBiIuU' find: ch) > 0⇒ [
self maskrun: i to: j under: ↪(1 1 2 2 4 4)◦t to: ↪(1 0 2 0 4 0)◦t]
(t ← 'fot' find: ch) > 0⇒ [
"new value follows"
v ← s integerScan.
t=1⇒ [self maskrun: i to: j under: 0360 to: (v lshift: 4)]]
]
]
bravoRuns: s "Encode the runs in a Bravo paragraph trailer onto a Stream"
| i old len dif new bit bits
["assume Ctrl-Z is already there"
s append: [alignment=1⇒['j\g']; =2⇒['c\g'] '\g'].
[runs≡nil ⇒ []
len ← 0. old ← 0400.
bits ← ↪(1 2 4).
for⦂ i from: 1 to: runs length by: 2 do⦂
[dif ← old lxor: (new ← runs◦(i+1)).
(dif land: 0367)=0 ⇒ "No changes" [len ← len+(runs◦i)]
[i=1⇒[] len printon: s].
for⦂ bit to: 3 do⦂
[(dif land: bits◦bit)=0 ⇒ []
s next ← ([(new land: bits◦bit)≠0 ⇒ ['biu'] 'BIU'])◦bit].
[(dif land: 0360)≠0 ⇒ "Font change"
[s append: 'f'; print: (new lshift: ¬4); space]].
old ← new.
len ← runs◦i.
]
].
s cr]
fromBravo "Find Bravo trailers and return a copy of self with them applied"
| newpara newtext loc i j
[newpara ← self copy.
loc ← 1.
while⦂ (i ← (newtext ← newpara text) find: 032)≠0 do⦂
[j ← newtext◦(i+1 to: newtext length) find: 015.
newpara applyBravo: newtext◦(i+1 to: i+j) at: loc to: i-1.
newpara replace: i to: [i+j=newtext length⇒[i+j] i+j-1] by: ''.
loc ← i+1]
⇑newpara]
toBravo | s [
s ← (String new: text length*2) asStream.
s append: text; next ← 032.
self bravoRuns: s.
⇑s contents asParagraph]
Press printing
fromPress: press value: s | len x [
[s next=0⇒ [
"text is in DL"
len ← s nextword.
"amount to skip from where we are now to end of text"
x ← [s limit > 255⇒ ["control info came from DL" s limit] "from EL" 0].
press data skip: 0-x-len.
text ← press data next: len.
press data skip: x]
text ← s nextString].
runs ← s nextString.
alignment ← s next.
runs empty⇒ [runs ← nil]]
hideData: complete | s [
s ← Stream new of: (String new: 150).
s next ← complete.
[complete=0⇒ [s nextword ← text length] s nextString ← text].
s nextString← [runs≡nil⇒ [nullString] runs];
next← alignment.
⇑s contents]
hidePress: press complete: c [
"not called by Form-Path-Image, but probably by Class printout"
press skipcode: self pressCode data: (self hideData: c)]
pressCode [⇑99]
presson: press in: r [⇑self presson: press in: r style: self textStyle]
presson: press in: r style: style | char pos s3 y chop [
"Output paragraph inside rectangle (page coordinates)"
"probably ParagraphScanner should handle this"
text length > 0 and⦂ text◦1 = 014⇒ [
"formfeed --> page break"
⇑self copy: 2 to: text length]
y ← r corner y. "We change corner y later"
s3 ← ParagraphScanner new of: self to: press style: style.
s3 init in: r.
pos ← s3 position.
chop ← [alignment=1⇒ [0] alignment].
while⦂ (y and⦂ (char ← s3 scan)) do⦂ [
char = 011 ⇒ [s3 tab]
char = 040 or⦂ char = 015 ⇒ [
"carriage return or exceeded max width and backed up to blank"
y ← s3 printfrom: pos aligned: [char=040⇒[alignment] chop] skip: 1⇒
[r corner y ← y. s3 init in: r. pos ← s3 position]]
char ≡ true ⇒[
"exceeded max width with no blanks in line"
s3 backup.
y ← s3 printfrom: pos aligned: 0 skip: 0⇒
[r corner y ← y. s3 init in: r. pos ← s3 position]]
"user notify: 'unimplemented control char'"].
"Put out trailing text if any"
y and⦂ ((pos=s3 position) or⦂ (y ← s3 printfrom: pos aligned: chop skip: 0))⇒ [
press append: text.
⇑y]
press append: text◦(1 to: pos).
⇑self copy: pos + 1 to: text length]
Filing
readFrom: file [
text ← file nextString.
runs ← file nextString.
alignment ← file next.
runs empty⇒ [runs ← nil]]
storeOn: file [
file nextString ← text.
[runs≡nil⇒ [file next ← 0] file nextString ← runs].
file next ← alignment]
SystemOrganization classify: ↪Paragraph under: 'Text Objects'.
"Reader"
Class new title: 'Reader'
subclassof: Object
fields: 'source collector token nextchar typetbl '
declare: 'typetable ';
asFollows
Converts a string to tokens. The collector defines what to do for each kind of token: see TokenCollector and Compressor for examples. (P. Deutsch)
Initialization
classInit | strm type first last i "Initialize the type and mask tables"
[typetable← String new: 256.
strm← Stream new of: ↪(
5 0 0377 "(initialize)"
1 0101 0132 1 0141 0172 "upper and lower case letters"
2 060 071 "digits"
3 072 072 3 03 03 "colon, open colon"
4 011 012 4 014 015 4 040 040 "TAB, LF, FF, CR, blank"
"5 is one-char tokens"
6 042 042 6 031 031 "comment quote and ➲"
7 047 047 "string quote"
8 025 025 "high-minus"
9 032 032 "^Z (format trailer)"
10 036 036 "DOIT"
11 050 051 "open and close paren"
).
while⦂ (type← strm next) do⦂
[first← strm next. last← strm next.
for⦂ i from: (first+1 to: last+1) do⦂
[typetable◦i← type]
]
]
of: s
[typetbl← typetable.
token← Stream default.
source← s asStream.
self step]
Main reader
read
[⇑self readInto: TokenCollector default]
readatom: ncolons | type s
[token reset.
while⦂ [token next← nextchar.
(nextchar← source next)⇒[(type← typetbl◦(nextchar+1))≤3]
false]
do⦂
[type=3⇒[ncolons← ncolons+1]].
s← token contents.
ncolons=0⇒[collector identifier: s];
>1⇒[collector otheratom: s].
s length=1⇒[collector otheratom: s] ": or ⦂ alone"
s◦s length=072⇒[collector keyword: s];
=03⇒[collector keyword: s].
collector otheratom: s. "Colon wasn't last character"
]
readInto: collector | x
[while⦂ nextchar do⦂
[x← typetbl◦(nextchar+1).
"See classInit for the meanings of the type codes"
x=4⇒ [collector separator: nextchar. nextchar← source next];
=1⇒ [self readatom: 0];
=5⇒ [collector onechar: nextchar. nextchar← source next];
=6⇒ [self upto: nextchar⇒[collector notify: 'Unmatched comment quote']
collector comment: token contents];
=2⇒ [self readnum];
=11⇒ [[nextchar=050⇒[collector leftparen] collector rightparen].
nextchar← source next];
=7⇒ [self upto: nextchar⇒[collector notify: 'Unmatched string quote']
collector string: token contents];
=8⇒ [self readnum];
=9⇒ [self upto: 015⇒[collector notify: '^Z without CR']
collector trailer: token contents];
=10⇒ [⇑collector contents];
=3⇒ [self readatom: 1]
]
⇑collector contents]
readnum | val d e
[val← self rdint: 025.
nextchar=056⇒ "check for decimal point"
[self step.
nextchar≡false or⦂ nextchar isdigit≡false⇒
[collector integer: val. collector onechar: 056] "was <Integer> . "
d← self rdint: ¬1. "fraction part"
[nextchar=0145⇒ "check for e<exponent> "
[self step. e← self rdint: 025]
e← ''].
collector float: val fraction: d exp: e]
collector integer: val]
Internal readers
rdint: char "Read an integer, allow char as first char"
[token reset.
[nextchar=char⇒[token next← char. self step]].
while⦂ nextchar do⦂
[nextchar<060⇒[⇑token contents]
nextchar>071⇒[⇑token contents]
token next← nextchar. nextchar← source next].
⇑token contents]
step
[nextchar← source next]
upto: char | start "Knows about doubled ' in strings"
[start← source position.
token reset.
while⦂ (nextchar← source next) do⦂
[[nextchar=char⇒
[self step. char≠047⇒[⇑false] nextchar≠047⇒[⇑false]]].
token next← nextchar].
"Ran off end, back up."
source skip: start - 1 - source position.
⇑true]
SystemOrganization classify: ↪Reader under: 'Text Objects'.
Reader classInit
"RemoteParagraph"
Class new title: 'RemoteParagraph'
subclassof: Object
fields: 'file hipos lowpos'
declare: '';
asFollows
These instances refer to text stored on a file, typically residing on a remote
machine and accessed via the ether. The representation has been chosen for
compactness, and the bias of ¬1000 keeps the two parts of the position in the
range of small integers (¬1024 to 1022) to reduce allocation and paging of objects.
As yet unclassified
asParagraph [
file position ← self position.
⇑Paragraph new readFrom: file]
asString [⇑self asParagraph text]
fromParagraph: p [
"write me (only once!) on file"
self position ← file position.
p storeOn: file]
fromString: s [self fromParagraph: s asParagraph]
on: file "Refer me to a specific file"
position [⇑(hipos+1000)*2000 + (lowpos+1000)]
position← p
[p ← p intdiv: 2000.
hipos← (p◦1) asInteger -1000.
lowpos← (p◦2) asInteger -1000]
SystemOrganization classify: ↪RemoteParagraph under: 'Text Objects'.
"Textframe"
Class new title: 'Textframe'
subclassof: Object
fields: 'frame para style reply1 reply2 window'
declare: '';
asFollows
I display a paragraph on the screen in a frame clipped by a window
Initialization
para: para frame: frame
[window←frame.
reply1←reply2←0.
style←DefaultTextStyle]
para: para frame: frame style: style
[window←frame.
reply1←reply2←0]
style: style
Scheduling
aboutToFrame
["My frame is about to change. I dont care."]
takeCursor
["Move the cursor to the center of my window."
user cursorloc ← window center]
Image
asForm: pt | char ul ur f
"put bits of character into a form -- when Form package in system"
[char ← self charofpt: pt. ul ← reply1.
self ptofchar: char + 1. ur ← reply1.
f ← Form new size: ur x - ul x by: reply2 y - reply1 y.
f translate: ul; scale: 1. ⇑f ]
comp
[window comp]
copyto: path effect: effect | i oldmode "show clipped inside rect"
[
path is: Point ⇒
[oldmode ← style mode. style mode: effect. window translateto: path. self show. style mode: oldmode.]
path is: Path ⇒ [for⦂ i to: path length do⦂ [ self copyto: path◦i effect: effect] ]
]
corner [⇑frame corner]
displayat: path effect: effect clippedBy: cliprect| i oldmode "show clipped inside rect"
[
path is: Point ⇒
[oldmode ← style mode. style mode: effect. frame translateto: path. window ← cliprect. self show. style mode: oldmode. ]
path is: Path ⇒ [for⦂ i to: path length do⦂ [ self displayat: path◦i effect: effect] ]
]
erase
[(window inset: (¬2⌾¬2)) clear]
extent [⇑frame extent]
frame [⇑frame]
frame ← frame
["Change my frame and window."
window ← frame.
]
height [⇑frame height]
origin [⇑frame origin]
outline
[window border: 2 color: black]
para [⇑para]
showin: rect | old "show clipped inside rect"
[old ← window. window ← rect. self show. window ← old]
size [⇑frame extent]
style [⇑style]
width [⇑frame width]
window [⇑window]
Text
charnearpt: pt [user croak] primitive: 58
charofpt: pt [user croak] primitive: 58
dopressjst: pt
["For building justified lines in Press Format files
[reply1 x ← trailingbits.
reply1 y ← internalspaces.
reply2 y ← heightofline.
[reply2 x < 0 ⇒[linenotjustified]].
⇑lastcharinline]
user will have to back up in string to find last printing character
(at least non-space, cr, or tab)"
user croak] primitive: 64
findmaxx: char
[char is: Integer⇒[user croak]
self findmaxx: char asInteger] primitive: 63
lastshown
[⇑reply1]
lineheight
[⇑style lineheight]
maxx: char
[self findmaxx: char. ⇑ reply1]
measuretext: startx to: stopx string: string from: first to: last font: font
["Returns character index of character immediately following character
causing exception condition.
Reply1 = Exception code.
= 1 Encountered space, cr, tab, or ascii 0.
= 2 Crossed stopx.
= 3 Both 1 and 2.
= 4 Encountered last before hitting stopx or special character.
Reply2 = Leftx of character causing exception condition."
user croak] primitive: 103
ptofchar: char
[self selectchar: char. ⇑reply1]
ptofpt: pt
[self charnearpt: pt. ⇑reply1]
put: para at: pt
[self put: para at: pt centered: false]
put: para at: pt centered: center
[para ← para asParagraph.
window ← frame ← pt rect: 1000⌾1000.
self ptofchar: para length+1.
window growto: reply2 + (4⌾0).
[center⇒ [window moveby: pt-window center]].
window ← window inset: ¬3⌾¬2.
window clear: white. self show]
put: para at: pt maxextent: maxextent
[para ← para asParagraph.
window ← frame ← Rectangle new origin: pt extent: maxextent.
self findmaxx: para length+1.
window growto: reply2.
window ← window inset: ¬3⌾¬2.
window clear: white. self show]
put: para centered: pt
[self put: para at: pt centered: true]
rectofchar: char
[self selectchar: char. ⇑reply1 rect: reply2]
scrolln: n
[⇑self charofpt: frame corner x ⌾ (frame origin y+(n*style lineheight))]
selectchar: char
[char is: Integer⇒[user croak]
self selectchar: char asInteger] primitive: 59
show [user croak] primitive: 57
show: para
[para ← para asParagraph. self show]
showline: first to: last lastx: lastx spaces: spaces trailingspaces: trailingspaces startrun: startrun firstrunlength: firstrunlength
["For use in conjunction with measuretext primitive.
Characters first through last will be displayed, clipped by the frame
and window. The lastx should be the lastx of last. If justification
is on in para and spaces is > 0, the line will be justified.
Passing spaces as 0 causes suppression of justificaton even if
justification is turned on in para; space characters will be displayed
normally even when spaces is 0.
Trailingspaces is needed for justification. Startrun is an integer index
into the runs, indicating which run to start on. Firstrunlength
is the number of characters remaining in run startrun. Note that
while runs in a paragraph are allocated as a string, startrun will
be considered a word index.
maxascent and maxdescent in style must be nonnil to avoid a croak."
user croak] primitive: 104
Conversion
makeParagraph ["simulate ListPane for hardcopy"
para≡nil⇒ [para ← 'NIL !' asParagraph]]
Printing
hardcopy | pf [user displayoffwhile⦂ [
pf ← dp0 pressfile: 'frame.press'.
window hardcopy: pf.
self hardcopy: pf.
pf close; toPrinter]]
hardcopy: pf | r first last lasty len parag left right top bottom [
[para≡nil⇒ [self makeParagraph]].
parag ← para asParagraph.
frame=window⇒ [parag presson: pf in: (pf transrect: window) style: style]
left ← frame minX max: window minX.
right ← window maxX min: frame maxX.
bottom ← window maxY min: frame maxY.
top ← window minY max: frame minY.
lasty ← top + 4. "slop for char finding and making print rect larger"
first ← self charofpt: left+1 ⌾ lasty.
len ← parag length.
frame minX ≥ left and⦂ frame maxX ≤ right⇒ [
"paragraph is inset and may be scrolled"
(parag copy: first to: len) presson: pf in: (
pf transrect: (left ⌾ top rect: right ⌾ (bottom+4))) style: style]
"yuk, frame extends left or right so do it a line at a time for clipping"
while⦂ (first < len and⦂ lasty < bottom) do⦂ [
last ← (self charofpt: right-1 ⌾ lasty) min: len.
r ← self rectofchar: last.
lasty ← lasty + r height.
(parag copy: first to: last) presson: pf in:
(pf transrect: (left ⌾ (r minY) rect: right ⌾ lasty)) style: style.
first ← last+1]]
SystemOrganization classify: ↪Textframe under: 'Text Objects'.
"ParagraphEditor"
Class new title: 'ParagraphEditor'
subclassof: TextImage
fields: 'oldEntity sel'
declare: 'on off ';
asFollows
This version of ParagraphEditor (for use in CodePanes) is based on TextImage
Scheduling
enter [
begintypein ← false.
self show; select]
leave [self complement: off]
Editing
again | many
[many← user leftShiftKey.
[self fintype⇒ [Scrap ← Scrap text. self select]].
many⇒[while⦂ self againOnce do⦂ []]
self againOnce⇒[] frame flash]
againOnce | t
[t ← para findString: Deletion startingAt: c2.
t=0⇒ [⇑false]
self unselect.
c1 ← t.
c2 ← c1 + Deletion length.
self replace: Scrap; selectAndScroll]
copy [Scrap ← self selection]
cut [self fintype; replace: nullString; complement. Scrap ← Deletion]
paste [self fintype; replace: Scrap; selectAndScroll]
realign [self align. sel ← on]
undo [self fintype; replace: Deletion; complement]
Public Messages
contents [⇑para]
Deletion ← s [Deletion ← s]
fixframe: f | dy [
dy ← [frame≡nil⇒ [0] self frameoffset].
window ← f copy.
frame ← Rectangle new origin: window origin + (2⌾dy)
extent: window width-4 ⌾ 9999.
⇑window]
formerly [⇑oldEntity]
formerly: oldEntity
frame← f [self fixframe: f]
kbd | more char "key struck on the keyboard"
[c1<c2 and⦂ self checklooks⇒[⇑self show complement]
more ← Set new string: 16.
[begintypein⇒[] Deletion ← self selection. begintypein ← c1].
while⦂ (char ← user kbdnext) do⦂ [
char
=bs⇒ ["backspace"
more empty⇒ [begintypein ← begintypein min: (c1 ← 1 max: c1-1)]
more skip: ¬1];
=cut⇒ [self fintype. [c1=c2⇒[c2← c1+1 min: para length+1]].
self replace: nullString; complement. Scrap ← Deletion. ⇑self];
=paste⇒ [⇑self paste];
=ctlw⇒ ["ctl-w for backspace word"
[more empty⇒ [] self replace: more. more reset. c1 ← c2].
c1 ← 1 max: c1-1.
while⦂ [c1>1 and⦂ (para◦(c1-1)) tokenish] do⦂ [c1 ← c1-1].
begintypein ← begintypein min: c1];
=esc⇒ ["select previous type-in"
[more empty⇒[self unselect]
self replace: more. c1 ← c2].
self fintype.
c1 ← c2-Scrap length.
⇑self complement]
"just a normal character"
more next← char].
self replace: more.
c1 ← c2.
self selectAndScroll]
keyset
Scrap ← s [Scrap ← s]
scrollby: n | oldw [
n ← (n * self lineheight) max: self frameoffset.
frame moveby: 0⌾(0-n).
n abs ≥ window height⇒ [self show; select]
"need only to reshow part of window"
oldw ← window.
window ← [n < 0⇒ [window inset: 0⌾0 and: 0⌾(0-n)]
window inset: 0⌾n and: 0⌾0].
window blt: window origin - (0⌾n) mode: storing.
[n<0⇒ [window corner y ← window origin y - n]
window origin y ← window corner y - n].
self show; select.
window ← oldw]
scrollPos | t [
t ← self height - self lineheight.
t=0⇒ [⇑0.0]
⇑0.0 - self frameoffset / t]
scrollTo: f [self scrollUp: self frameoffset + (f* self height) - 4]
scrollUp: n [self scrollby: n/self lineheight]
select: t [
self complement: off.
c1 ← c2 ← t.
self selectAndScroll]
selectAndScroll | l dy c1y [
l ← self lineheight.
self select.
c1y ← (self ptofchar: c1) y.
dy ← c1y - window minY.
[dy ≥ 0⇒ [
dy ← c1y + l - 1 - window maxY max: 0]].
dy≠ 0⇒ [self scrollby: (dy abs+l-1) / l * dy sign]]
selecting | pt t [
t ← self charofpt: (pt ← user mp).
self complement: off; fintype.
[t=c1 and⦂ c1=c2⇒ [ "bugged hairline - maybe double-bug"
while⦂ [user redbug and⦂ t=(self charofpt: user mp)]
do⦂ []. "wait for unclick or drawing selection"
user redbug≡false⇒[self selectword; select. ⇑true]]].
sel ← on.
⇑super select: pt]
selection [para text empty⇒ [⇑para copy] ⇑para copy: c1 to: c2-1]
selectionAsStream [⇑Stream new of: para text from: c1 to: c2-1]
show [self primshow. sel ← off]
typing [self kbd]
unselect [self complement: off]
Private
checklooks | t val mask [
t ← ↪(166 150 137 151 230 214 201 215
135 159 144 143 128 127 129 131 180 149
199 223 208 207 192 191 240 226) find: user kbck.
t=0⇒[⇑false]
user kbd.
[oldEntity⇒[] oldEntity ← para. para ← para copy].
t=25⇒[para ← para toBravo]; "ctl-T"
=26⇒[para ← para fromBravo]. "ctl-F"
val ← ↪(1 2 4 256 ¬1 ¬2 ¬4 256 "ctl-b i - x B I ¬ X"
0 16 32 48 64 80 96 112 128 144 "ctl-0 1 ... 9"
160 176 192 208 224 240)◦t. "ctl-shift-0 1 ... 5"
[val=256⇒[mask← 0377. val← 0] "reset all"
val<0⇒[mask← 0-val. val← 0] "reset emphasis"
val>0 and⦂ val<16⇒[mask← val] "set emphasis"
mask← 0360]. "set font"
para maskrun: c1 to: c2-1 under: mask to: val]
classInit [on ← 1. off ← 0]
complement [self complement: on]
complement: nsel [
nsel = sel⇒ ["already that way"]
nsel = on and⦂ (user rawkbck or⦂ user redbug)⇒ ["slippage"]
sel ← nsel.
self reversefrom: c1 to: c2]
frameoffset [
"a useful number"
⇑frame minY - window minY]
height [
self selectchar: para length+1.
⇑reply2 y - frame minY]
primshow [user croak] primitive: 57
replace: t [
[oldEntity⇒ [] oldEntity ← para. para ← para copy].
[begintypein⇒ [] Deletion ← self selection].
para replace: c1 to: c2-1 by: t.
c2 ← c1 + t length.
self show]
select [self selectIn: nil]
selectIn: w [
sel ← off.
[c1≡nil⇒ [c1 ← c2 ← 1]].
self complement: on]
selectRange [⇑c1 to: c2-1]
selectRange: r [
"self complement: off"
c1 ← r start.
c2 ← r stop
"self complement: on"]
selectword | a b dir t level open close s slen
[
"Select bracketed or word range, as a result of double-bug."
a← b← dir← ¬1.
s ← para text.
slen ← s length.
level ← 1.
open ← '([{<''"
'.
close ← ')]}>''"
'.
[c1≤1⇒[dir←1. t←c1]
c1> slen⇒[t←c1-1]
t←open find: (a← para◦(c1-1)). t>0⇒ "delim on left"
[dir←1. b←close◦t. t←c1-1] "match to the right"
t←close find: (a← para◦c1). t>0⇒ "delim on right"
[dir←¬1. b←open◦t. t←c1] "match to the left"
a← ¬1. t←c1]. "no delims - select a token"
until⦂ (level=0 or⦂ [dir=1⇒[t≥slen] t≤1]) do⦂
[s◦(t← t+dir) = b⇒ [level← level-1]; "leaving nest"
= a⇒ [level← level+1]. "entering nest"
a=¬1⇒[(s◦t) tokenish⇒ "token check goes left "
[t=1⇒[c1← dir← 1. t← c2]]
dir=¬1⇒[c1 ← t+1. dir←1. t←c2-1] "then right"
level← 0]]
[level≠0⇒[t← t+dir]].
dir=1⇒[c2← t min: slen+1] c1← t+1
]
SystemOrganization classify: ↪ParagraphEditor under: 'Text Objects'.
ParagraphEditor classInit
"TextStyle"
Class new title: 'TextStyle'
subclassof: Object
fields: 'fonts "<Vector of Strings or Integers> which are the fonts.
An integer entry has a vertical offset in the high 8 bits, a 1 in
the 200-bit for descent, and another font number (zero-relative)
in the bottom 4 bits"
tabandspace "<Integer> =256*tabwidth + spacewidth"
maxascent "<Integer> max ascent for this fontset"
maxdescent "<Integer> max descent for this fontset"
mode "<Integer> =0 for normal, =4 for white-on-black"
fontnames "<Vector of Strings> corresponding to the fonts"'
declare: '';
asFollows
I am a specification of how to display a paragraph. I include a font set, a tab spacing, a space size, etc. If I do not specify ascent and descent from the baseline, then each line displayed will adjust to its tallest characters.
Initialization
default
[tabandspace ← mode ← 0. self mode: 0; tab: 20; space: 5.
fonts ← Vector new: 16. fontnames ← Vector new: 16.
self setfont: 0 name: 'CREAM10'. "Put default font in font 0"
]
mode
[⇑ mode]
mode: mode
space
[⇑ (tabandspace land: 0377)]
space: t
[tabandspace ← (tabandspace land: 0177400) + (t land: 0377)]
tab
[⇑ ((tabandspace land: 0177400) lshift: ¬8)]
tab: t
[tabandspace ← (tabandspace land: 0377) + (t lshift: 8)]
Fonts
fontfamily: n | s char
["return the family name taken out of fontnames"
s ← Stream default.
for⦂ char from: fontnames ◦ n do⦂
[char isletter⇒ [s next ← char]
⇑s contents]]
fontnames [⇑fontnames]
fonts [⇑fonts]
fontsize: n | s c size
["return size from fontname"
size ← 0. s ← (fontnames ◦ n) asStream.
while⦂ (c ← s next) isletter do⦂ [].
while⦂ [size ← size*10 + (c - 060). c ← s next] do⦂ [].
⇑size]
setfont: n fromfile: name
[self setfont: n name: name fromstring: (dp0 oldFile: name + '.strike.') contents]
setfont: n name: name | ucn
[FontDict has: (ucn← name asUppercase)⇒
[self setfont: n name: ucn fromstring: FontDict◦ucn]
self setfont: n fromfile: name]
setfont: n name: name fromstring: string
"Should update maxascent, maxdescent"
[fontnames◦(n+1) ← name asUppercase.
fonts◦(n+1) ← string.
FontDict insert: fontnames◦(n+1) with: string]
setoffsetfont: n from: m by: d
[fonts◦n ← m + [d<0⇒ [0200] 0] + (d lshift: 8)]
writeset: styleindex
[self writeset: styleindex as: fontnames◦(styleindex+1)]
writeset: styleindex as: name
["write out a formset on name with strike extention"
name ← name + '.strike.'.
(dp0 file: name) append: fonts◦ (styleindex+1) ; close.